perm filename NETWRK.FAI[S,NET]36 blob
sn#847472 filedate 1987-10-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00049 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00008 00002 Network routines, intended to be .INSERT'ed History
C00016 00003 Assembly switches
C00022 00004 INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND HDEAD RSET TMO ERRBTS WINBTS NET DAT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%MIL NW%SI NW%SU NW%36 NW%08 NW%P08 NW%P36
C00027 00005 NWKDBG ERRCLR HSTADR HSTTOP HDBPTR DHSTST TTYFIL TTYPPN TTBSIZ TTYNAM OPNBLK NETDEV CONBLK CONSTS CONLPR CONWAT CONBYT ICPSKT CONFPR HOST CONHST LSNBLK LSNSTS LSNSKT LSNPRT LSNWAT LSNBYT LSNFPR LSNHST STABLK STASND STARCV VARSET VART17 VARTMO
C00031 00006 TERBLK TERSTS TERPRT TERWAI WATBLK WATSTS WATPRT INRBLK INRSTS INRPRT INSBLK INSSTS INSPRT ABTBLK ABTSTS RMKBLK RMKSTS RMKDAT UDPBLK UDPSTS UDPLPR UDPFPR UDPHST WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT FBPORT LSOCKT LBPORT PRINUM NUMPRI PRIADR PRIMSK
C00037 00007 CONECT .CONEC
C00041 00008 LISTEN .LISTE
C00044 00009 DATI .DATI .DATI1
C00047 00010 DATO .DATO .DATO1
C00049 00011 CONCHK
C00050 00012 UDPCON .UDPCN
C00052 00013 NETICH NETICW NTICH2 NTICH4 NTICH3
C00055 00014 NETOCH .NETOC
C00056 00015 NETSND .NETSN NETOER
C00057 00016 DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
C00061 00017 DATOCH .DATOC
C00062 00018 DATSND .DATSN DATOER
C00064 00019 CLOSER CLSDAT CLOSEW
C00065 00020 NETINR NETINS ABORT
C00066 00021 MTPERR MTPER2 MTPER1 MTPE1A MERTAB MERLEN
C00070 00022 NIOERR NIOER2
C00072 00023 HSTDED
C00075 00024 HSTDE2
C00077 00025 HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN LOCDOM
C00088 00026 MAPHS2 MAPHST MAPHS0 MAPHS4 MAPHS3
C00091 00027 UNMHST
C00092 00028 HSTNUM HSTNUS HSTNU1 HSTNU2
C00096 00029 HSTNAM SEARCH SRCLT SRCGT SRCDUN SRCDU1 SRCDU2 COMPAR PMATCH PMATC1 PMATC2 CHKAMB GOTNAM AMBNAM GETHDB HSTNAB HSTNB1 HSTNB2 HSTNB3 HSTNB4 HSTNB5 HSTUNK HSTUN1 HSTUNA
C00108 00030 SRTADR SRTAD1 SRTAD2 SRTAD3 PRIORI PRIOR1 SRTADF
C00111 00031 HSTNXA
C00112 00032 SVCCHK SVCCH1 SVCCH2 SVCCH3
C00114 00033 SETANM SETAN1 SETAN2
C00121 00034 HSTNBR IPNBR HSTNBE PUPNBR TXTNUM TXTNU1
C00124 00035 HNUMST HNUMS1 HNUMS2 HNUMS3 HNUMS5 HNUMSD HNUMSO HNUMSX
C00127 00036 OURNAM OURNA1
C00129 00037 ATTHST ATTHS0 ATTHS2 ATTCRE ATTMUL ATTUPP ATTLOW ATTERR MXATTE HSGNAM
C00132 00038 DETHST
C00133 00039 B%ADDRESS B%EXISTS B%DEFL VERSIO BLKSIZ NETADR NUMTTY DEFBLK TTYBLK TTYSTR TTYST1 CPYNAM CPYNA1 TTYST9 TTYREA TTYRE1
C00144 00040 Domain resource record format
C00152 00041 RRTYPE RRCLAS RRTTL RRDLEN RRNAME TY.A TY.NS TY.CNAME TY.SOA TY.MB TY.MG TY.MR TY.NULL TY.WKS TY.PTR TY.HINFO TY.MINFO TY.MX TY.AXFR TY.MAILB TY.ALL CL.IN CL.CH CL.ALL DOM NETIBF NETOBF DOMIBF DOMOBF NETBFL DOMBFL NETBUF DOMBUF DVERBOSE UPCASE AUTHOR NODFLT MXPREF OSNAME BLKLEN DLKBLK DLKNME NAMBLK DATBLK DATPTR MXDBLK MXHBLK MXABLK MXAPTR MXPBLK MXPPTR SETUDP QUERYB QDCOUNT ANCOUNT NSCOUNT ARCOUNT TEMPBP TTLMIN TTLMAX TTLNME TTLSFE NODOTS DFLTDM CNAMEC
C00159 00042 SUCCES NICKNM SFTERR NAMERR GETDOM GETDO1 GETDO2 GETDO3 GETDO5 GETDO6 GETDMA GETINP GETIN1 GETIN2 GETIN3 GETIN4 GT.UNK GTDISP GT.MAX GT.A GT.RET GT.MX GT.DOM GT.DO1 GT.DO2 GT.DO3 GT.WKS GT.HIN GT.HI1 GT.HI2
C00172 00043 SQUERY UNKERR FMTERR SRVFAI NOTIMP REFUSE RDRESP SKIPQR SKIPQ1 RDANS RDAUTH RDADDL NAMERX SFTERX CACHER SQURET
C00181 00044 READRR READR1 READR2 READR3 READR4 RD.UNK RDDISP RD.MAX RD.DAT RD.DA1 RDOUTP RD.MX RD.DOM RD.DO1 RD.DO2 READC0 READCP READC1 READC2
C00187 00045 NAMADR NAMADA NAMAD1 NAMAD2 NAMAD3 NAMHST NAMHST NAMHS1 NAMHS2 NAMHL1 NAMHL2 SRTDAT SRTDA1 SRTDA2 COMPRI COMPR1 NANAME
C00194 00046 ADRNAM ADRPTR ADRPT1 ADRPTD ADRPD1 ADRHST ADRHST ADRHS1 ADRHL1 ADADDR
C00198 00047 MXADDR MXFIND MXFINA MXNXTH MXFNDH MXFNH1 SRTMXA SRTMX1 SRTMX2 MXLOSE MXADDF MXNAME
C00206 00048 LDOMAN DOMAN DOMANX DOMANL A0 A1 A2 A3 OURDOM OURDO0 OURDO1 OURDOE OURDO2
C00210 00049 CPOPJ3 CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG LUZBI1 CTYMES ..NLIT
C00212 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSERT'ed ;⊗ History
; This is a library of network hacking routines. Each routine describes its
; calling sequence and what AC's it smashes. A pushdown stack is expected in 17.
;
; I/O channel 0 is smashed, I/O channel 1 (NET) is used as the general TELNET
; connection channel, and I/O channel 2 (DAT,DOM) is used for data I/O and the
; system domain record cache.
; This package can also be used with the Ethernet, but data connections are
; not implemented. Also, Ethernet does not have equivalent to INTINR, and
; simply sends an INTINS. Host down messages are bogus. (TVR/Dec81)
; This is the FAIL version which lives in NETWRK.FAI[S,NET]. The MIDAS version
; lives in NETWRK.MID[S,NET].
COMMENT ⊗ History (please record changes):
History recording began in August 1986.
Apr 78 MRC Original NETWRK for Arpanet NCP.
Dec 81 TVR Added support for Ethernet PUP connections.
Apr 83 ME,JJW Modified for Arpanet IP/TCP. Major change is
the elimination of ICP for Arpanet connections.
Jun 83 JJW Host table format changed from HOSTS2 to HOSTS3.
(1983-1986) Numerous changes, undocumented.
09 Aug 86 JJW Commented out IP address lookup kludge. (Host table we
now get from Argus has Stanford IP addresses.) Added
SRTADR to sort addresses (by modifying the HOSTS3 table
incore). Changed HSTNAB and HNUMST to accept and print
PUP addresses in the form [a#b], but PUP code useless
since it parses in decimal.
13 Aug 86 JJW Added HSTNBR to parse [a.b.c.d] in decimal or [a#b] in
octal. Doesn't look up number in host table.
26 Aug 86 ME,JJW Added ATTHST and DETHST for upper-segment host table.
Disabled call to SRTADR for use of this feature.
03 Sep 86 JJW Changed DETHST not to save high segment, since [RSLV]
phantom does.
10 Sep 86 JJW Changed SETANM to always use official name, supressing
hyphens and stopping at first "." in name.
03 Nov 86 ME Added symbols to refer to MJH 10MB network.
07 Nov 86 JJW Changed network priority to prefer MJH 10MB net, added DECWRL.
07 Nov 86 ME Add symbol NW%P36.
15 Dec 86 ME Added ERRCLR flag word: zero means never do CLRBFI (formerly
always did CLRBFI upon error typeout). Also, if user sets
VARSET, then timeouts are set from VARTMO cell.
15 Jan 86 ME "Fatal" errors now do an EXIT 1, instead of halting, so a
phantom (like the remind phantom) will go away (and return
later) instead of halting. Also, MTPERR and NIOERR, which
after all are just typing error messages, don't have any
FATAL errors, only WARNings.
23 Mar 87 ME Declared NTOBF internal (↑) so caller can tell if NETOCH will
do an OUT UUO (to allow ↑S checking in Pancake spooler).
16 Aug 87 JJW Added GETDOM for general domain name lookup, NAMADR and
ADRNAM for name/address translation using domains followed
by host table if domain lookup fails.
19 Aug 87 JJW Removed use of inverse address kludge. Use PTR records in
system cache as well as in server queries.
26 Aug 87 JJW Changed NAMADR, ADRNAM and MXFIND to have separate returns
for hard and soft errors.
27 Aug 87 ME Changed OURDOM to use lowcore pointer in RH of 356 to get
domain name from system. Provides emergency domain name. Made
ADRHL1 failure return a string containing dotted host number.
04 Sep 87 JJW Network output error when sending to domain server is non-fatal,
since a dead gateway can cause this.
06 Sep 87 JJW Data in TY.A records now stored same as other types. Type
TY.HINFO now supported.
07 Sep 87 JJW Domain routines now use statically allocated I/O buffers for
NET and DOM channels. UPCASE switch controls mapping of domain
characters to upper-case; is on by default, except when
appending default domain or when applied to names of MX hosts
that have been received from servers.
04 Oct 87 JJW Added code to prevent CNAME looping, and to zero UPCASE when
chasing CNAMEs in NAMADR and MXFIND. Implemented cached soft
errors. Fixed NAMADR to return soft error when appropriate.
Made MXADDR and MXFIND separate entries to avoid looking up
addresses when not needed.
11 Oct 87 JJW Top-level domain routines release DOM channel before returning.
Restructured SQUERY, made it IOPUSH channel NET. Errors from
domain server cause cached name or soft errors, not fatal exits
from program.
22 Oct 87 ME Put OURDOM under separate switch OURRTS (as well as DOMRTS)
so that PUPFTP can use it to get our host name.
25 Oct 87 JJW Added more networks to PRILST.
History: end of comment ⊗
; Assembly switches ;⊗
IFDEF FTHST3,<
PRINTS/Please remove the FTHST3 switch and non-HOSTS3 code from this program.
All NETWRK-reading programs must now use HOSTS3 host numbers.
/>;IFDEF FTHST3
IFNDEF SVRRTS,<SVRRTS←←0> ; ≠ 0 → server (not user) routines
IFNDEF DATRTS,<DATRTS←←0> ; ≠ 0 → data channel routines
IFNDEF MRKCHR,<MRKCHR←←0> ; ≠ 0 → pass BSP mark bytes as characters
IFNDEF ERRHAN,<ERRHAN←←0> ; ≠ 0 → automagic error reporting in NIORTS
IFNDEF ERRINS,<ERRINS←←<047000,,12>> ; (iff ERRHAN≠0) what to do after an error
IFNDEF HSTSIX,<HSTSIX←←0> ; ≠ 0 → sixbit alias name hacking
IFNDEF TTYSTS,<TTYSTS←←0> ; ≠ 0 → code to get TTY location string
IFNDEF IPUDP,<IPUDP←←0> ; ≠ 0 → IP/UDP code
IFNDEF MXRTS,<MXRTS←←0> ; ≠ 0 → MX routines
IFNDEF NIORTS,<NIORTS←←SVRRTS!DATRTS!ERRHAN> ; ≠ 0 → network I/O routines
IFNDEF ERRTNS,<ERRTNS←←ERRHAN> ; ≠ 0 → error reporting routines
IFNDEF HSTTAB,<HSTTAB←←HSTSIX> ; ≠ 0 → host table routines
IFNDEF DOMRTS,<DOMRTS←←MXRTS> ; ≠ 0 → domain routines
IFNDEF OURRTS,<OURRTS←←DOMRTS> ; ≠ 0 → OURDOM routine
IFE NIORTS!ERRTNS!HSTTAB!DOMRTS,<.FATAL No NETWRK routines selected>
IFE NIORTS,<IFN SVRRTS!DATRTS!ERRHAN,<.FATAL NIORTS Illegal switch setting>>
IFE ERRTNS,<IFN ERRHAN,<.FATAL ERRHAN Illegal switch setting>>
IFE HSTTAB,<IFN HSTSIX,<.FATAL HSTTAB Illegal switch setting>>
IFE NIORTS,<IFN MRKCHR,<.FATAL MRKCHR Illegal switch setting>>
;Macro definitions
;FATAL errors type a question mark and stop program at LUZBIG.
;WARNings type an exclamation point and continue.
;DEFINE FATAL(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING?\] ↔ JRST LUZBIG]>
;DEFINE WARN(STRING)<PUSHJ 17,[OUTSTR [ASCIZ\STRING!\] ↔ JRST WARNIN]>
DEFINE FATAL(STRING)<PUSHJ 17,[PUSH 17,[[ASCIZ\STRING?\]] ↔ JRST LUZBIG]>
DEFINE WARN(STRING)<PUSHJ 17,[PUSH 17,[[ASCIZ\STRING!\]] ↔ JRST WARNIN]>
;Timeouts for various flavors of connection (CLOSE,RFNM,ALLOC,RFC,INPUT,IDLE)
;(pre-TCP definitions)
;IFNDEF CNTIMO,<CNTIMO←←<BYTE (6)1,0,0,=15,5,0>> ; Connect
;IFNDEF LSTIMO,<LSTIMO←←<BYTE (6)1,=10,=10,=30,0,0>> ; Listen
;IFNDEF TNTIMO,<TNTIMO←←<BYTE (6)1,=15,0,5,0,0>> ; Telnet port
;IFNDEF DATIMO,<DATIMO←←<BYTE (6)2,24,0,7,0,0>> ; Data port
;TCP/PUP definitions. Because there is no ICP on a separate port, only
;one set of timeouts is defined for each type of connection. IMPSER no
;longer uses RFNM timeout, but PUPSER uses it to time out ACK failure.
IFNDEF CNTIMO,<CNTIMO←←<BYTE (6)1,=15,=60,=15,0,0>> ; Connect
IFNDEF LSTIMO,<LSTIMO←←<BYTE (6)1,=15,=60,=30,0,0>> ; Listen
IFDEF TNTIMO,<PRINTX TNTIMO no longer used or defined in NETWRK>
IFNDEF DATIMO,<DATIMO←←<BYTE (6)2,=20,0,7,0,0>> ; Data port
;Macro to zero all but network number in a word. Placed outside BEGIN so
;programs .INSERTing this file can use it.
DEFINE GETNET(AC,ADDR)<
IFDIF <ADDR><><MOVE AC,ADDR>
TLNN AC,(17⊗=32) ; Check for non-Internet type addrs
TLNN AC,(1⊗=31) ; Internet address, see if class A net
TDZA AC,[77,,-1] ; Unternet or class A, zap low 3 octets
TLNN AC,(1⊗=30) ; Class B or C, see which.
TRZA AC,177777 ; Class B network, zap low 2 octets
TRZ AC,377 ; Class C net, only zap 1 low octet
>;GETNET
;⊗ INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND HDEAD RSET TMO ERRBTS WINBTS NET DAT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%MIL NW%SI NW%SU NW%36 NW%08 NW%P08 NW%P36
; System bits and bytes
BEGIN NETWRK
; Goddam bagbiting assembler!!!
GLOBAL NIORTS,ERRHAN,ERRINS,ERRTNS,HSTTAB,SVRRTS,DATRTS,HSTSIX,MRKCHR
GLOBAL TTYSTS,IPUDP,DOMRTS,MXRTS,OURRTS
DEFINE FATAL(STRING)<PUSHJ 17,[PUSH 17,[[ASCIZ\STRING?\]] ↔ JRST LUZBIG]>
DEFINE WARN(STRING)<PUSHJ 17,[PUSH 17,[[ASCIZ\STRING!\]] ↔ JRST WARNIN]>
; Interrupt condition bits
↑INTINR←←<000100,,0> ; IMP INR
↑INTINS←←<000040,,0> ; IMP INS
↑INTIMS←←<000020,,0> ; IMP status change
↑INTINP←←<000010,,0> ; IMP input waiting
; Network status flags
↑RFCS←← <200000,,0> ; RFC sent
↑RFCR←← <100000,,0> ; RFC received
↑CLSS←← <040000,,0> ; CLS sent
↑CLSR←← <020000,,0> ; CLS received
; Network status word error codes
↑SIU←←01 ; port (socket) in use
↑CCS←←02 ; can't change port (socket) numbers
↑SYS←←03 ; horrible system error
↑NLA←←04 ; no links available
↑ILB←←05 ; illegal byte size
↑IDD←←06 ; IMP dead
↑GMM←←07 ; Gender mismatch
; I/O status word error bits
↑IOIMPM←←400000 ; improper mode
↑IODERR←←200000 ; hard device error
↑IODTER←←100000 ; soft device error
↑IOBKTL←←040000 ; block number out of bounds
↑IODEND←←020000 ; end of file
↑HDEAD←← 002000 ; host or destination IMP dead
↑RSET←← 000400 ; host sent a RST
↑TMO←← 000200 ; time out
ERRBTS←←<IOIMPM!IODERR!IODTER!IOBKTL!IODEND!HDEAD!RSET!TMO>
WINBTS←←<RFCS!RFCR> ; connection winning
; I/O channel definitions
↑NET←←1 ; channel to do network hacking
↑DAT←←2 ; channel to do data hacking
; Network numbers (for distinguishing IMP from local Ethernet)
↑NT$NUM←←301400 ;Byte pointer to network number (high 12 bits)
↑NE%UNT←←<040000,,0> ;Escape bit indicating "Unternet" type address
↑NE%STR←←<100000,,0> ;Escape bit indicating "string" type address
↑NN%IP←←<740000,,0> ;host number bits that are off for all IP addresses
↑NW%ARP←←<=10⊗=24> ;HOSTS3 uses full word network # values
↑NW%MIL←←<=26⊗=24> ;LLL is on MILnet
↑NW%SI←←44⊗=24 ;Internet address of SU-NET-TEMP
↑NW%SU←←NE%UNT!NW%SI ;"Unternet" used for Stanford Ethernet
↑NW%36←←NW%SI!44⊗=16 ;local 3-meg net
↑NW%08←←NW%SI!10⊗=16 ;local 10-meg net
↑NW%P08←←NW%SU!10⊗=8 ;"Unternet" 10-meg subnet in MJH
↑NW%P36←←NW%SU!44⊗=8 ;"Unternet" 3-meg subnet in MJH
;⊗ NWKDBG ERRCLR HSTADR HSTTOP HDBPTR DHSTST TTYFIL TTYPPN TTBSIZ TTYNAM OPNBLK NETDEV CONBLK CONSTS CONLPR CONWAT CONBYT ICPSKT CONFPR HOST CONHST LSNBLK LSNSTS LSNSKT LSNPRT LSNWAT LSNBYT LSNFPR LSNHST STABLK STASND STARCV VARSET VART17 VARTMO
; Data area
NWKDBG: 0 ; -1 → do OUTCHR on network I/O
↑ERRCLR:-1 ;nonzero means clear typeahead on error typeout
IFN HSTTAB,<
; Host table pointers
↑HSTADR:BLOCK 1 ; ≠ 0 → address of beginning of host table
; = 0 → host table not in core
HSTTOP: BLOCK 1 ; top of host table (JOBFF at map time)
HDBPTR: BLOCK 1 ; pointer to relative HDB
; Block for ASCIZ text of dotted host number of host not in table
DHSTST: BLOCK 10
>; End IFN HSTTAB
IFN TTYSTS,<
TTYFIL: SIXBIT/TTYINI/ ;File of SU-Ethernet TTY information
SIXBIT/BIN/
TTYPPN: SIXBIT/HSTNET/
TTBSIZ: BLOCK 1 ;Size of TTY info block, read from file
TTYNAM: BLOCK 10 ;Block to return TTY string
>;End IFN TTYSTS
IFN NIORTS,<
OPNBLK: 0
↑NETDEV:'IMP',,0 ; device name
NTOBF,,NTIBF ; buffers
; CONNECT MTAPE block
CONBLK: 0 ; CONNECT
CONSTS: BLOCK 1 ; returned status bits
CONLPR: BLOCK 1 ; local port
CONWAT: BLOCK 1 ; ≠ 0 → wait for connection until timeout
CONBYT: BLOCK 1 ; byte size
↑ICPSKT:: ;(old name, for compatibility)
↑CONFPR:BLOCK 1 ; foreign port
↑HOST:
CONHST: BLOCK 1 ; foreign host
IFN SVRRTS,<
; LISTEN MTAPE block
LSNBLK: 1 ; LISTEN
LSNSTS: BLOCK 1 ; returned status bits
↑LSNSKT:: ;(old name, for compatibility)
↑LSNPRT:BLOCK 1 ; local port to listen to
LSNWAT: BLOCK 1 ; ≠ 0 → wait for connection
LSNBYT: BLOCK 1 ; byte size
LSNFPR: BLOCK 1 ; foreign port
LSNHST: BLOCK 1 ; foreign host
>; End IFN SVRRTS
STABLK: 2 ;STATUS
STASND: BLOCK 1 ;Send side status
STARCV: BLOCK 1 ;Receive side status
;Both IMPSER and PUPSER store the same values in the above two words.
↑VARSET:0 ;nonzero means use timeouts in VARTMO below
;MTAPE block for setting timeouts
VART17: 17
↑VARTMO:0 ;place for use to stick desired timeouts
;⊗ TERBLK TERSTS TERPRT TERWAI WATBLK WATSTS WATPRT INRBLK INRSTS INRPRT INSBLK INSSTS INSPRT ABTBLK ABTSTS RMKBLK RMKSTS RMKDAT UDPBLK UDPSTS UDPLPR UDPFPR UDPHST WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT FBPORT LSOCKT LBPORT PRINUM NUMPRI PRIADR PRIMSK
; More data area, shared by USER and SERVER
;TERMINATE MTAPE block
TERBLK: 3 ;TERMINATE
TERSTS: BLOCK 1 ;Returned status bits
TERPRT: BLOCK 1 ;Port number
TERWAI: BLOCK 1 ;Wait flag
repeat 0,< ;Leftover from NCP days
; WAIT MTAPE block
WATBLK: 4 ; WAIT
WATSTS: BLOCK 1 ; returned status bits
WATPRT: BLOCK 1 ; port number
; INTERRUPT MTAPE blocks
INRBLK: 11 ; SEND INTERRUPT
INRSTS: BLOCK 1 ; returned status bits
INRPRT: BLOCK 1 ; port number
INSBLK: 11
INSSTS: BLOCK 1
INSPRT: BLOCK 1
>;repeat 0
;ABORT MTAPE block
ABTBLK: 22 ;ABORT
ABTSTS: BLOCK 1 ;Returned status bits
IFN MRKCHR,<
RMKBLK: 26 ; READ MARK
RMKSTS: BLOCK 1
RMKDAT: BLOCK 1 ; mark byte returned here
>; End IFN MRKCHR
IFN IPUDP,<
UDPBLK: 26 ;Set UDP parameters
UDPSTS: BLOCK 1 ;Returned status bits
↑UDPLPR:BLOCK 1 ;Local port
0
0
↑UDPFPR:BLOCK 1 ;Foreign port
↑UDPHST:BLOCK 1 ;Foreign host
>;IFN IPUDP
; Other stuff
WHYWHY: BLOCK 1 ; host down word
; I/O buffer headers
NTIBF: BLOCK 3 ; network input buffer header
↑NTOBF: BLOCK 3 ; network output buffer header
IFN DATRTS,<
DTIBF: BLOCK 3 ; network data input buffer header
DTOBF: BLOCK 3 ; network data output buffer header
>; End IFN DATRTS
; Base ports, set up by CONECT and LISTEN
↑FSOCKT:: ;(old name, for compatibility)
↑FBPORT:BLOCK 1 ; foreign base port
↑LSOCKT:: ;(old name, for compatibility)
↑LBPORT:BLOCK 1 ; local base port
>; End IFN NIORTS
IFN HSTTAB!DOMRTS,<
;Table for sorting host addresses
;In the following list, addresses that are more specific should be
;earlier. I.e., a subnetwork should precede its parent network, so
;that the comparison on the subnetwork will take precedence.
DEFINE PRILST<
PRIMAC(14,<004402,,0>,<777777,,777400>) ;Internet MJH 10MB
PRIMAC(13,<004411,,0>,<777777,,777400>) ;Internet MJH 3MB
PRIMAC(12,<004400,,0>,<777700,,000000>) ;Internet SU-Net
PRIMAC(11,<044400,,004000>,<777777,,777400>) ;Pup MJH 10MB
PRIMAC(10,<044400,,022000>,<777777,,777400>) ;Pup MJH 3MB
PRIMAC(7,<044400,,000000>,<777700,,000000>) ;Pup SU-Net
;Networks accessible via Ethernet. (We should really get
;this info dynamically from system.)
PRIMAC(6,<030006,,414400>,<777777,,777400>) ;Lucid
PRIMAC(6,<020013,,200000>,<777777,,600000>) ;DECRWL
PRIMAC(6,<020010,,000000>,<777777,,600000>) ;UC Berkeley
PRIMAC(6,<020031,,400000>,<777777,,600000>) ;NASA AMES
PRIMAC(6,<020034,,400000>,<777777,,600000>) ;UC Santa Cruz
PRIMAC(6,<020036,,000000>,<777777,,600000>) ;UC Davis
PRIMAC(6,<020066,,400000>,<777777,,600000>) ;UC San Francisco
PRIMAC(6,<030007,,657400>,<777777,,777400>) ;UC Pres. Office
PRIMAC(6,<020046,,600000>,<777777,,600000>) ;NASA Langley
PRIMAC(6,<020045,,200000>,<777777,,600000>) ;JPL
PRIMAC(6,<020055,,600000>,<777777,,600000>) ;NASA Goddard
PRIMAC(6,<020047,,400000>,<777777,,600000>) ;NASA Marshall
PRIMAC(5,<001200,,0>,<777700,,0>) ;Arpanet
PRIMAC(4,<003200,,0>,<777700,,0>) ;Milnet
PRIMAC(3,<000000,,0>,<740000,,0>) ;Any Internet address
>;DEFINE PRILST
DEFINE PRIMAC(NUM,ADDR,MASK)<NUM>
PRINUM: PRILST
NUMPRI←←.-PRINUM
DEFINE PRIMAC(NUM,ADDR,MASK)<ADDR>
PRIADR: PRILST
DEFINE PRIMAC(NUM,ADDR,MASK)<MASK>
PRIMSK: PRILST
>;IFN HSTTAB!DOMRTS
;⊗ CONECT .CONEC
; CONECT -- Connect to foreign host
; Call: MOVEM <host number>,HOST
; MOVEM <foreign port number>,CONFPR
; PUSHJ 17,CONECT
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
IFN NIORTS,<
IFE SVRRTS,<
; Open channels and set timeouts
↑CONECT:
IFN ERRHAN,<
PUSHJ 17,.CONEC
JRST [PUSHJ 17,MTPERR ↔ ERRINS]
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.CONEC: GETNET 0,HOST ; check network type
MOVEI 1,'IMP' ; Assume not PUP
CAMN 0,[NW%SU] ; Ethernet?
MOVEI 1,'PUP' ; Yes, use PUP
MOVSM 1,NETDEV ; specify device for OPEN
CAIN 1,'PUP'
HRRZS HOST ; Don't confuse PUPSER with net number
OPEN NET,OPNBLK ; open NET in ASCII mode
JRST [ MOVEI 0,0 ; failed, maybe device is detached
JRST CPOPJ1] ; return 0 to indicate no device
SKIPE VARSET ;want timeouts set from variable cell?
MTAPE NET,VART17 ;set timeouts from VARTMO
SKIPN VARTMO
MTAPE NET,[17 ↔ CNTIMO]
SETOM CONLPR ; gensym local port
SETOM CONWAT ; do wait until timeout
MTAPE NET,CONBLK ; connect → foreign server
MOVE CONLPR ; get gensymmed port
MOVEM LBPORT ; save local base port
MOVE CONSTS ; get MTAPE status
MOVEM WHYWHY ; save it
GETSTS NET, ; check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TRNE 77 ; check for MTAPE error
POPJ 17,
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal state?
POPJ 17,
MOVE CONFPR ; get port we got
MOVEM FBPORT ; save foreign port for later
MOVE CONLPR ; for completeness and compatibilty
repeat 0,<
MOVEM INSPRT
>;repeat 0
MOVEM TERPRT
MOVEI =8 ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[10]
CAI
JRST CPOPJ2
>; End IFE SVRRTS
;⊗ LISTEN .LISTE
; LISTEN -- Listen for a connection from a foreign host
; Call: MOVEM <local port number>,LSNPRT
; MOVEM <device name>,NETDEV ;If omitted, then use IMP
; PUSHJ 17,LISTEN
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return--host we connected to in HOST>
; Smashes 0 and 1.
IFN SVRRTS,<
; Open channels and set timeouts (punts after a minute)
↑LISTEN:
IFN ERRHAN,<
PUSHJ 17,.LISTE
JRST [PUSHJ 17,MTPERR ↔ ERRINS]
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.LISTE: OPEN NET,OPNBLK ; open NET in ASCII mode
FATAL Network device INIT failure
MOVS 1,NETDEV
SKIPE VARSET ;want timeouts set from variable cell?
MTAPE NET,VART17 ;set timeouts from VARTMO
SKIPN VARTMO
MTAPE NET,[17 ↔ LSTIMO] ; set timeouts
SETOM LSNWAT ; do wait until timeout
MTAPE NET,LSNBLK
MOVE LSNSTS ; check for MTAPE error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS NET, ; check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal state?
POPJ 17,
MOVE LSNHST
MOVEM CONHST
MOVE LSNFPR
MOVEM FBPORT ; save foreign base port
MOVE LSNPRT ; remember local port
MOVEM LBPORT
repeat 0,<
MOVEM INSPRT ; for completeness, set this as well
>;repeat 0
MOVEM TERPRT
MOVEI =8 ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[10]
CAI
JRST CPOPJ2
>; End IFN SVRRTS
;⊗ DATI .DATI .DATI1
; DATI -- Open data input network channel
; Call: PUSHJ 17,DATI
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return--byte size in 0>
; Smashes 0 and 1.
IFN DATRTS,<
↑DATI:
IFN ERRHAN,<
PUSHJ 17,.DATI
JRST [PUSHJ 17,MTPERR ↔ ERRINS]
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.DATI: CHNSTS DAT, ; check for channel open
JUMPN .DATI1
INIT DAT,0 ; open channel
('IMP')
DTOBF,,DTIBF ; buffers
FATAL IMP INIT failure
SKIPE VARSET ;want timeouts set from variable cell?
MTAPE DAT,VART17 ;set timeouts from VARTMO
SKIPN VARTMO
MTAPE DAT,[17 ↔ DATIMO]
.DATI1: MOVE LBPORT
ADDI 4 ; ICP/U receive data offset
MOVEM CONLPR ; local receive port
MOVE FBPORT
ADDI 3 ; ICP/S transmit data offset
MOVEM CONFPR ; foreign transmit port
SETOM CONWAT ; wait
MTAPE DAT,CONBLK ; connect ← foreign data output
MOVE CONSTS ; test for error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS DAT,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
MTAPE DAT,[15 ↔ 1] ; system maximum allocation
MOVE CONBYT ; change byte size in buffer header
DPB [300600,,DTIBF+1]
INBUF DAT,
MTAPE DAT,[10]
CAI
JRST CPOPJ2
;⊗ DATO .DATO .DATO1
; DATO -- Open data output network channel
; Call: MOVEI <byte size of connection>
; PUSHJ 17,DATO
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
↑DATO:
IFN ERRHAN,<
PUSHJ 17,.DATO
JRST [PUSHJ 17,MTPERR ↔ ERRINS]
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.DATO: MOVEM CONBYT
CHNSTS DAT,
JUMPN .DATO1
INIT DAT,0 ; open channel
('IMP')
DTOBF,,DTIBF ; buffers
FATAL IMP INIT failure
SKIPE VARSET ;want timeouts set from variable cell?
MTAPE DAT,VART17 ;set timeouts from VARTMO
SKIPN VARTMO
MTAPE DAT,[17 ↔ DATIMO]
.DATO1: MOVE LBPORT
ADDI 5 ; ICP/U transmit data offset
MOVEM CONLPR ; local receive port
MOVE FBPORT
ADDI 2 ; ICP/S receive data offset
MOVEM CONFPR ; foreign transmit port
SETOM CONWAT ; wait
MTAPE DAT,CONBLK ; connect → foreign data input
MOVE CONSTS ; test for error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS DAT,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
MOVE CONBYT ; change byte size in buffer header
DPB [300600,,DTOBF+1]
OUTBUF DAT,
JRST CPOPJ2
>; End IFN DATRTS
;⊗ CONCHK
;CONCHK -- Check status of network connection.
;Call: PUSHJ 17,CONCHK
; <return if error or no connection open>
; <return if connection open and no error>
;Connection status is returned in 0 in either case.
↑CONCHK:MTAPE NET,STABLK ;Get status
MOVE STASND ;Pick up "send side" status
TRNE 77 ;Check for MTAPE error
POPJ 17,
TLC (WINBTS) ;For next instruction to win
TLCE (WINBTS) ;Legal state?
POPJ 17,
JRST CPOPJ1
;⊗ UDPCON .UDPCN
;;; Note: This code experimental and subject to change.
;UDPCON -- Set up IP/UDP connection.
;Call: MOVEM <host number>,UDPHST
; MOVEM <local port number or -1>,UDPLPR
; MOVEM <foreign port number or -1>,UDPFPR
; PUSHJ 17,UDPCON
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
;Smashes 0 and 1.
IFN IPUDP,<
↑UDPCON:
IFN ERRHAN,<
PUSHJ 17,.UDPCN
JRST [PUSHJ 17,MTPERR ↔ ERRINS]
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>;End IFN ERRHAN
.UDPCN: MOVEI 1,'IMP' ;Can't do this with PUP!
MOVSM 1,NETDEV
OPEN NET,OPNBLK ;Open NET in ASCII mode
FATAL Network device INIT failure
MTAPE NET,UDPBLK ;Set UDP parameters for connection
MOVE UDPSTS ;Get MTAPE status
MOVEM WHYWHY ;Save it
GETSTS NET, ;Check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TRNE 77 ;Check for MTAPE error
POPJ 17,
MOVEI =8 ;Change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
SKIPE VARSET ;want timeouts set from variable cell?
MTAPE NET,VART17 ;set timeouts from VARTMO
SKIPN VARTMO
MTAPE NET,[17 ↔ CNTIMO]
JRST CPOPJ2
>;End IFN IPUDP
;⊗ NETICH NETICW NTICH2 NTICH4 NTICH3
; NETICH/NETICW -- Read a character from the network
; Call: PUSHJ 17,NETICH or PUSHJ 17,NETICW
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <error return--no characters available> iff NETICH
; <return--character in 0>
; Smashes 0, 1, and 2.
↑NETICH:TDZA 2,2 ; don't hang
↑NETICW: SETO 2, ; hang
IFN ERRHAN,<
PUSHJ 17,NTICH2
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17, ; NETICW or empty NETICH
JRST CPOPJ1 ; NETICH return
>; End IFN ERRHAN
NTICH2: SOSLE NTIBF+2 ; anything in buffer?
JRST NTICH3
JUMPN 2,NTICH4
HRRZ 1,NTIBF
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST NTICH4
MTAPE NET,[10] ; no, any input available?
JRST CPOPJ1 ; no, empty error return
NTICH4: IN NET, ; yes, read the buffer
JRST NTICH3 ; won
GETSTS NET, ; error, get status
IFN MRKCHR,<
TRNN 0,IOBKTL ; mark seen?
>; End IFN MRKCHR
POPJ 17, ; I/O error return
IFN MRKCHR,<
MTAPE NET,RMKBLK ; read mark byte
POPJ 17, ; failed
MOVE 0,RMKDAT
TRO 0,400 ; send it in specially marked package
JRST CPOPJ2 ; good return
>; End IFN MRKCHR
NTICH3: ILDB NTIBF+1 ; get the character
SKIPE NWKDBG
OUTCHR
JUMPN 2,CPOPJ1 ; NETICW only skips once
JRST CPOPJ2 ; NETICH good return
;⊗ NETOCH .NETOC
; NETOCH -- Output a character to the network
; Call: MOVE <character>
; PUSHJ 17,NETOCH
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0.
↑NETOCH:
IFN ERRHAN,<
PUSHJ 17,.NETOC
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.NETOC: SOSG NTOBF+2 ; space available in buffer?
OUT NET, ; no, output it
CAIA ; win
JRST NETOER
IDPB NTOBF+1 ; put character in buffer
SKIPE NWKDBG
OUTCHR
JRST CPOPJ1 ; success
;⊗ NETSND .NETSN NETOER
; NETSND -- Force network buffer out
; Call: PUSHJ 17,NETSND
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
↑NETSND:
IFN ERRHAN,<
PUSHJ 17,.NETSN
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.NETSN: OUT NET, ; send the buffer
JRST [ AOS NTOBF+2 ; poor NETOCH will lose big otherwise
JRST CPOPJ1]
NETOER: GETSTS NET, ; lost, get status
POPJ 17, ; and return
;⊗ DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
; DATICH/DATICW -- Read a character from the network data channel
; Call: PUSHJ 17,DATICH or PUSHJ 17,DATICW
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <error return--no characters available> iff DATICH
; <return--character in 0>
; Smashes 0, 1, and 2.
IFN DATRTS,<
↑DATICH:TDZA 2,2 ; don't hang
↑DATICW: SETO 2, ; hang
IFN ERRHAN,<
PUSHJ 17,DTICH2
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17, ; DATICW or empty DATICH
JRST CPOPJ1 ; DATICH return
>; End IFN ERRHAN
DTICH2: SOSLE DTIBF+2 ; anything in buffer?
JRST DTICH3
JUMPE 2,[ HRRZ 1,DTIBF
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST .+1
MTAPE DAT,[10] ; no, any input available?
JRST CPOPJ1 ; no, empty error return
JRST .+1] ; input available or hang
IN DAT, ; yes, read the buffer
JRST DTICH3 ; won
GETSTS DAT, ; error, get status
POPJ 17, ; I/O error return
DTICH3: LDB [300600,,DTIBF+1] ; get byte size
CAIE =8
JRST [ ILDB DTIBF+1 ; non-ASCII data mode
JUMPN 2,CPOPJ1
JRST CPOPJ2]
IBP DTIBF+1 ; increment pointer to hack
MOVE @DTIBF+1 ; get word to hack
ANDI 17 ; only marking bits
JFFO DTICH1 ; count leading zeros
LDB DTIBF+1 ; get the character
JUMPN 2,CPOPJ1 ; DATICW only skips once
JRST CPOPJ2 ; DATICH good return
; Have to flush nulls here.
DTICH1: MOVNI 1,-44(1) ; get -1,,# of padding characters
HRRZM 1,1(17) ; stash # of characters away on stack
MOVEI 1,-1(1) ; # of characters to take off buffer
SUBM 1,DTIBF+2 ; remove padding characters from count
MOVNS DTIBF+2 ; SUBM goes the wrong way
SKIPE 1 ; maybe no adjustment necessary
DTIC1A: IBP DTIBF+1
SOJG 1,DTIC1A ; increment byte ptr given nbr of bytes
MOVN 1,1(17) ; get # of characters back from stack
LSH 1,3 ; # of bits to shift over
MOVE @DTIBF+1 ; get word we are hacking
LSH (1) ; right justify its bytes
MOVEM @DTIBF+1 ; store it back again
JRST DTICH2 ; now try it again
;⊗ DATOCH .DATOC
; DATOCH -- Output a character to the network data channel
; Call: MOVE <character>
; PUSHJ 17,DATOCH
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0.
↑DATOCH:
IFN ERRHAN,<
PUSHJ 17,.DATOC
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.DATOC: SOSG DTOBF+2 ; space available in buffer?
OUT DAT, ; no, output it
CAIA ; win
JRST DATOER
IDPB DTOBF+1 ; put character in buffer
JRST CPOPJ1 ; success
;⊗ DATSND .DATSN DATOER
; DATSND -- Force network buffer out
; Call: PUSHJ 17,DATSND
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
↑DATSND:
IFN ERRHAN,<
PUSHJ 17,.DATSN
JRST [PUSHJ 17,NIOERR ↔ ERRINS]
POPJ 17,
>; End IFN ERRHAN
.DATSN: LDB 1,[410300,,DTOBF+1] ; get position field
MOVEI 1
LSH (1) ; AC0 ← 2↑<# of null characters>
SOS ; AC0 ← mask to flush nulls
IORM @DTOBF+1 ; ensure padding nulls aren't sent
OUT DAT, ; send the buffer
JRST [ AOS DTOBF+2 ; poor NETOCH will lose big otherwise
JRST CPOPJ1]
DATOER: GETSTS DAT, ; lost, get status
POPJ 17, ; and return
>; End IFN DATRTS
;⊗ CLOSER CLSDAT CLOSEW
; CLOSER/CLSDAT -- Close a connection
; Call: PUSHJ 17,CLOSER or PUSHJ 17,CLSDAT
; <return>
; Smashes 0.
↑CLOSER:CLOSE NET,
RELEASE NET,
OUTSTR [ASCIZ/
Connection closed.
/]
POPJ 17,
IFN DATRTS,<
↑CLSDAT:CLOSE DAT,
RELEASE DAT,
POPJ 17,
>; End IFN DATRTS
;CLOSEW -- Close a connection and wait, using MTAPE for this.
;Call: PUSHJ 17,CLOSEW
; <return>
↑CLOSEW:SETOM TERWAI ;Set wait flag
MTAPE NET,TERBLK ;Close connection
POPJ 17,
;⊗ NETINR NETINS ABORT
repeat 0,< ;Leftover from NCP days
; NETINR/NETINS -- Send network interrupts to TELNET connection
; Call: PUSHJ 17,NETINR (or NETINS)
; <return>
; Smashes 0.
↑NETINR:MTAPE NET,INRBLK ; interrupt from receiver
POPJ 17,
↑NETINS:MTAPE NET,INSBLK ; interrupt from sender
POPJ 17,
>;repeat 0
; ABORT -- Abort TCP connection (send reset)
; Call: PUSHJ 17,ABORT
; <return>
↑ABORT: CHNSTS NET,ABTSTS ;see if channel is open
HRLZS ABTSTS ;put INITB into sign bit
SKIPGE ABTSTS ;skip if no channel open
MTAPE NET,ABTBLK ;send TCP reset
POPJ 17,
>; End IFN NIORTS
;⊗ MTPERR MTPER2 MTPER1 MTPE1A MERTAB MERLEN
; MTPERR -- Explain MTAPE lossage
; Call: MOVE <MTAPE status bits>
; PUSHJ 17,MTPERR
; <return>
; Smashes 0 and 1.
IFN ERRTNS,<
↑↑MTPERR:TRNE 77 ; UUO lossage?
JRST MTPER1 ; yes, different message
TLNN (CLSR) ; closed by foreign host?
SKIPA 1,[[ASCIZ/Time out
/]]
MOVEI 1,[ASCIZ/Refused
/]
OUTSTR (1)
SKIPE ERRCLR ;want to clear typeahead on error?
CLRBFI ;yup, clear it
POPJ 17,
; MTAPE UUO lossage
MTPER1: ANDI 77 ; only error code
CAILE MERLEN ; error code too high?
JRST [ OUTSTR [ASCIZ/MTAPE error #/]
IDIVI 10
ADDI "0"
ADDI 1,"0"
OUTCHR
OUTCHR 1
JRST MTPE1A]
;;; CAIN 0,15 ;Is it the "host dead" code?
;;; JRST HSTDED ;Yes, say why
MOVE 1,
MOVE 1,MERTAB-1(1) ;Get word from table
OUTSTR (1) ;Output the error string
TLNN 1,600000 ;Print crlf if not warning or fatal
OUTSTR [ASCIZ/
/]
;Don't need to stop during simple error message typeout.
; TLNE 1,400000 ;Test for fatal error
; JRST LUZBIG
TLNE 1,200000 ;Test for warning
MTPE1A: WARN
SKIPE ERRCLR ;want to clear typeahead on error?
CLRBFI ;yup, clear it
POPJ 17,
;Bits in LH: 400000 if fatal error (says find a wizard) ;No longer implemented.
; 200000 if warning (says please report via GRIPE NETWORK)
MERTAB: 200000,,[ASCIZ/Port in use/]
200000,,[ASCIZ/Can't change port/]
200000,,[ASCIZ/System error/] ; horrible IMPSER bug; RTS&STR but no DDB
[ASCIZ/No free links/]
200000,,[ASCIZ/Illegal byte size/]
[ASCIZ/IMP dead/]
200000,,[ASCIZ/Gender mismatch/] ; the Anita Bryant feature
;TOPS-10 error codes (from TCPSER.MAC[S,SYS]):
200000,,[ASCIZ/State error/] ;(10)
[ASCIZ/Can't get there from here/] ;(11)
200000,,[ASCIZ/Not enough internal buffer space/] ;(12)
[ASCIZ/Illegal host number/] ;(13)
[ASCIZ/Destination net unreachable/] ;(14)
[ASCIZ/Destination host unreachable/] ;(15)
[ASCIZ/Destination protocol unreachable/] ;(16)
[ASCIZ/Destination port unreachable/] ;(17)
200000,,[ASCIZ/Fragmentation needed and DF set/] ;(20)
200000,,[ASCIZ/Source route failed/] ;(21)
200000,,[ASCIZ/Destination unreachable: unknown code/] ;(22)
MERLEN←←.-MERTAB
;⊗ NIOERR NIOER2
; NIOERR -- Explain network I/O lossage
; Call: MOVE <I/O status bits>
; PUSHJ 17,NIOERR
; <return>
; Smashes 0, 1, and 2.
↑NIOERR:JUMPE 0,NIOER2 ;no bits means OPEN failed
ANDI ERRBTS ;error bits only
SKIPN
WARN No network error status
SKIPE ERRCLR ;want to clear typeahead on error?
CLRBFI ;yup, clear it
TRNE IOBKTL
WARN Network block-too-large error
TRNE IOIMPM
OUTSTR [ASCIZ/Connection closed
/]
TRNE RSET
OUTSTR [ASCIZ/Connection was reset
/]
TRNE TMO
OUTSTR [ASCIZ/Time out
/]
TRNE IODEND
OUTSTR [ASCIZ/Host closed connection
/]
TRNE HDEAD
JRST HSTDED
POPJ 17,
NIOER2: OUTSTR [ASCIZ/Network device unavailable (maybe being debugged)
/]
SKIPE ERRCLR ;want to clear typeahead on error?
CLRBFI ;yup, clear it
POPJ 17,
;⊗ HSTDED
; HSTDED -- Explain why a host is dead
HSTDED: LDB [260400,,WHYWHY] ; get what's wrong first
JUMPE [ OUTSTR [ASCIZ/Net trouble
/]
POPJ 17,] ; 0 → destination IMP down
CAIE 1 ; 1 → destination host down
JRST [ CAIN 2 ; 2 → destination host talks 32 bit leaders
JRST [ OUTSTR [ASCIZ/Communication with host not possible because it only talks 32 bit leaders
This probably indicates a hardware error at the other host, since 32-bit
leaders have been invalid since January 1, 1981.
/]
POPJ 17,]
ifn 0,<
cain 17 ; Funny code from CONECT for bad net?
JRST [ OUTSTR [ASCIZ/Host net is inaccessible
/]
POPJ 17,]
>;ifn 0
OUTSTR [ASCIZ/Communication prohibited!
/] ; 3 → host access prohibited
POPJ 17,]
OUTSTR [ASCIZ/Host dead, /]
LDB 1,[220400,,WHYWHY] ; dead host status
OUTSTR @(1)[ [ASCIZ/reason unknown/]
[ASCIZ/system down/]
[ASCIZ/foreign NCP down/]
[ASCIZ/host doesn't exist/]
[ASCIZ/NCP initialization/]
[ASCIZ/scheduled PM/]
[ASCIZ/hardware work/]
[ASCIZ/software work/]
[ASCIZ/emergency restart/]
[ASCIZ/power failure/]
[ASCIZ/software breakpoint/]
[ASCIZ/hardware error/]
[ASCIZ/scheduled down/]
[ASCIZ/down code #13/]
[ASCIZ/down code #14/]
[ASCIZ/coming up now/]]
OUTSTR [ASCIZ/
/]
;⊗ HSTDE2
; Hairy "when host up" code
LDB [061400,,WHYWHY] ; get time when back up
JUMPE CPOPJ
CAIN 7776 ; -2 → unknown future time
POPJ 17,
OUTSTR [ASCIZ/ Host is expected back up /]
CAIN 7777 ; -1 → more than a week
JRST [ OUTSTR [ASCIZ/over a week from now./]
POPJ 17,]
LDB 1,[040500,,0] ; 1.5→1.9 hours
LDB 2,[110300,,0] ; 2.1→2.3 day of week
SUBI 1,=8 ; PST/GMT offset
MOVEI 3,261 ; DAYLIT
PEEK 3,
PEEK 3,
SKIPE 3
AOSL 1 ; daylight losing time
JUMPGE 1,HSTDE2
ADDI 1,=24 ; hours become positive again
SOJGE 2,HSTDE2 ; back up a day
MOVEI 2,6 ; back to Monday
HSTDE2: OUTSTR @(2)[ [ASCIZ/on Monday at /]
[ASCIZ/on Tuesday at /]
[ASCIZ/on Wednesday at /]
[ASCIZ/on Thursday at /]
[ASCIZ/on Friday at /]
[ASCIZ/on Saturday at /]
[ASCIZ/on Sunday at /]
[ASCIZ/on April Fool's Day at /]]
IDIVI 1,=10
ADDI 1,"0"
OUTCHR 1
ADDI 2,"0"
OUTCHR 2
OUTCHR [":"]
LDB 1,[000400,,0] ; 1.1→1.4 minutes/5
IMULI 1,5. ; make into real minutes
IDIVI 1,=10
ADDI 1,"0"
OUTCHR 1
ADDI 2,"0"
OUTCHR 2
JUMPE 3,[ OUTSTR [ASCIZ/ PST
/]
POPJ 17,]
OUTSTR [ASCIZ/ PDT
/]
POPJ 17,
>; End IFN ERRTNS
;⊗ HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN LOCDOM
; Host table routines
IFN HSTTAB,<
; Herein is the description of the compiled binary file (HOSTS3.BIN).
; General terms:
; "fileaddr" = a file address, relative to start of file.
; "netaddr" = a network address, in HOSTS3 format.
;
; All strings (hostnames etc) are uppercase ASCIZ, word-aligned and
; fully zero-filled in the last word. The strings are stored in the
; file in such a way that their locations are sorted, and only ONE
; copy of any distinct string is stored - everything that references
; the same string points to the same place. Thus it is reasonable to
; compare string pointers for = as well as < and >, which is much
; faster than comparing the strings.
;The format of the compiled output file is:
HSTSID←←0 ; wd 0 SIXBIT /HOSTS3/
HSTFN1←←1 ; wd 1 SIXBIT FN1 of source file (eg HOSTS)
HSTVRS←←2 ; wd 2 SIXBIT FN2 of source file (TNX: version #)
HSTDIR←←3 ; wd 3 SIXBIT directory name of source file (eg SYSENG)
HSTDEV←←4 ; wd 4 SIXBIT device name of source file (eg AI)
HSTWHO←←5 ; wd 5 SIXBIT login name of person who compiled this
HSTDAT←←6 ; wd 6 SIXBIT Date of compilation as YYMMDD
HSTTIM←←7 ; wd 7 SIXBIT Time of compilation as HHMMSS
NAMPTR←←10 ; wd 10 Fileaddress of NAME table.
SITPTR←←11 ; wd 11 Fileaddress of SITE table.
NETPTR←←12 ; wd 12 Fileaddress of NETWORK table.
NTNPTR←←13 ; wd 13 Fileaddress of NETNAME table.
;....expandable....
HDRLEN←←14 ; length of header
; NETWORK table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (2)
; This table contains one entry for each known network.
; It is sorted by network number.
; Each entry contains:
NETNUM←←0 ; wd 0 network number (full netaddr)
NTLNAM←←1 ; wd 1 LH - fileaddr of ASCIZ name of network
NTRTAB←←1 ; wd 1 RH - fileaddr of network's ADDRESS table
NETLEN←←2
; ADDRESS table(s)
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (3)
; There is one of these tables for each network. It contains entries
; for each site attached to that network, sorted by network address.
; These tables are used to convert a numeric address into a host name.
; Also, the list of network addresses and services for a site is stored
; within these tables.
; Each entry contains:
ADDADR←←0 ; wd 0 Network address of this entry, in HOSTS3 fmt.
ADLSIT←←1 ; wd 1 LH - fileaddr of SITE table entry
ADRCDR←←1 ; wd 1 RH - fileaddr of next ADDRESS entry for this site
; 0 = end of list
ADLXXX←←2 ; wd 2 LH - unused
ADRSVC←←2 ; wd 2 RH - fileaddr of services list for this address
; 0 = none, else points to SERVICE node of format:
SVLCNT←←0 ; <# wds>,,<fileaddr of next, or 0>
SVRCDR←←0
SVLFLG←←1 ; <flags>,,<fileaddr of svc name>
SVRNAM←←1
SVCARG←←2 ; <param1> ? <param2> ? ...
ADDLEN←←3
; SITE table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (3)
; This table contains entries for each network site,
; not sorted by anything in particular. A site can have more
; than one network address, usually on different networks.
; This is the main, central table.
; Each entry looks like:
STLNAM←←0 ; wd 0 LH - fileaddr of official host name
STRADR←←0 ; wd 0 RH - fileaddr of first ADDRESS table entry for this
; site. Successive entries are threaded
; together through ADRCDR.
STLSYS←←1 ; wd 1 LH - fileaddr of system name (ITS, TIP, TENEX, etc.)
; May be 0 → not known.
STRMCH←←1 ; wd 1 RH - fileaddr of machine name (PDP10, etc.)
; May be 0 → not known.
STLFLG←←2 ; wd 2 LH - flags:
STFSRV←←400000 ; 4.9 1 → server site (has FTP or TELNET)
STFGWY←←200000 ; 4.8 1 → Internet Gateway site (HOSTS3 only)
SITLEN←←3
; NAMES table:
; wd 0 Number of entries
; wd 1 Number of words per entry. (1)
; This table is used to convert host names into network addresses. It
; contains entries sorted alphabetically by host name.
NMLSIT←←0 ; wd 0 LH - fileaddr of SITE table entry for this host.
NMRNAM←←0 ; wd 0 RH - fileaddr of host name
; This name is official if NMRNAM = STLNAM of NMLSIT.
NAMLEN←←1
; NETNAME table:
; wd 0 Number of entries
; wd 1 Number of words per entry. (1)
; This table is used to convert network names into network numbers. It
; contains entries sorted alphabetically by network name, exactly as
; for the NAMES table. Although the symbols below are different (in order
; to make semantic distinctions), programs can depend on the fact
; that the NETNAME table format is identical to that of the NAMES table.
NNLNET←←0 ; wd 0 LH - fileaddr of NETWORK table entry for this host.
NNRNAM←←0 ; wd 0 RH - fileaddr of network name
NTNLEN←←1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;; HOSTS3 Network Address Format ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
comment |
HOSTS3 network address format:
4.9-4.6 - 4 bits of format type, which specify interpretation of
the remaining 32 bits.
IN 0000 - Internet address (handles ARPA, RCC, LCS)
4.5-1.1 - 32 bits of IN address.
UN 0001 - Unternet address. Same format, but not part of Internet.
4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
3.6-1.1 - address value in next 24 bits.
This handles CHAOS and any local nets. The network
numbers are unique within the HOSTS3 table but
don't necessarily mean anything globally, as do
Internet network numbers.
0011 - String address.
4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
3.6-3.1 - 0
2.9-1.1 - address of ASCIZ string in file/process space
Note that the "network number" for all of these formats is located in
the same place. However, for fast deciphering of the entire range of
possibilities, one could simply consider all of the high 12 bits as the
network number. Beware of the Internet class A, B, and C formats, though;
the only truly general way to compare network numbers is to use their
masked 36-bit values, although simpler checks are OK for specific nets.
For this reason (among others) network numbers are represented by
full 36-bit values with the "local address" portion zero.
The 4-bit "String address" value is much more tentative than the IN or UN
values. Bit 4.9, the sign bit, is being reserved as usual for the possible
advent of a truly spectacular incompatible format.
|
HSTFIL: SIXBIT/HOSTS3/ ;Filename and extension of binary file
SIXBIT/BIN/
HSTPPN: SIXBIT/HSTNET/ ;PPN of binary file
;The following is for a kludge in HSTNAM. It should be read from the file.
LOCDOM: ASCIZ/Stanford.EDU/ ;Local domain's parent
;⊗ MAPHS2 MAPHST MAPHS0 MAPHS4 MAPHS3
; MAPHST -- Map host table into core
; Call: PUSHJ 17,MAPHST
; <return>
; Smashes 0, 1, 2, and 3.
MAPHS2: HRROS (17) ;indicate want host table in new upper segment
JRST MAPHS0
↑MAPHST:HRRZS (17) ;indicate want host table in lower segment
MAPHS0: SKIPE HSTADR
JRST [ WARN Host table already mapped
POPJ 17,]
INIT 17
('DSK')
0
FATAL DSK INIT failure
DMOVE 0,HSTFIL
MOVE 3,HSTPPN
LOOKUP 0
JRST [ OUTSTR [ASCIZ/Host table LOOKUP failure (/]
ANDI 1,77
IDIVI 1,10
ADDI 1,"0" ↔ ADDI 2,"0"
OUTCHR 1 ↔ OUTCHR 2 ↔ OUTCHR [")"]
JRST LUZBIG]
MOVS 0,3 ;unswap file length
MOVN 0,0 ;make file length positive
SKIPGE (17) ;going into upper?
JRST MAPHS3 ;yes
MOVE 2,JOBFF↑ ;place to put table
ADDB 0,JOBFF↑ ;get address of highest addr we need
MOVEM 0,HSTTOP
CORE 0, ;get more core from system maybe
FATAL CORE UUO failure
MAPHS4: MOVE 0,3 ;negative length in LH
HRRI 0,-1(2) ;compute IOWD to read host table in
MOVEI 1,0
INPUT 0 ;read whole host table
MOVE 0,(2) ;get first word of host table
CAME 0,HSTFIL
FATAL Bad host table
MOVEM 2,HSTADR ;remember where host table begins
RELEAS
POPJ 17,
MAPHS3: MOVEI 2,400000 ;place to put host table, beginning of upper
ADDI 0,(2) ;ending address of table
MOVEM 0,HSTTOP ;end of table
CORE2 0, ;get enough core in upper segment
FATAL CORE2 UUO failed for host table space in segment
JRST MAPHS4
;⊗ UNMHST
; UNMHST -- Unmap host table from core
; Call: PUSHJ 17,UNMHST
; <return>
; Smashes 0 and 1.
↑UNMHST:SKIPN 1,HSTADR ; host table in core?
JRST [ WARN Host table not mapped
POPJ 17,]
MOVE (1)
CAME HSTFIL
FATAL Bad host table
MOVE HSTTOP ; check JOBFF from before
CAMLE JOBFF↑ ; smashed too?
FATAL Host table after JOBFF
CAME JOBFF↑
JRST [ WARN Host table locked
POPJ 17,]
SETZM HSTADR ; remove table pointer/interlock
MOVEM 1,JOBFF↑ ; return host table to free storage
CORE 1, ; and garbage collect
FATAL CORE UUO failure
POPJ 17,
;⊗ HSTNUM HSTNUS HSTNU1 HSTNU2
; HSTNUM -- Return descriptor block for a host
; Call: MOVEI <host number>
; PUSHJ 17,HSTNUM
; <error return--no such host>
; <return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2,
; address block in 3>
; Smashes 0, 1, 2, 3, and 4.
↑HSTNUM:SKIPN 1,HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,HSTFIL
FATAL Bad host table
GETNET 4,0 ; get network number
MOVE 1,NETPTR(1)
PUSHJ 17,HSTNUS ; lookup network number
POPJ 17,
MOVE 1,NTRTAB(1) ; get address table for network
MOVEM 4 ; thing to search for
PUSHJ 17,HSTNUS ; lookup address
POPJ 17,
MOVE 3,1 ; Save address table entry
HLRZ 1,ADLSIT(1) ; Get site table entry
ADD 1,HSTADR
AOS (17) ; successful return
JRST GETHDB ; return useful stuff in ACs
HSTNUS: ADD 1,HSTADR ; relocate table
MOVE 2,(1) ; get # of entries
MOVE 3,1(1) ; and entry size
ADDI 1,2 ; point at first entry
HSTNU1: CAMN 4,(1) ; found it?
JRST CPOPJ1 ; yes, skip return for success
ADD 1,3 ; point at next entry
SOJG 2,HSTNU1 ; keep on searching
repeat 0,< ;JJW 8/86 We now get IP addresses from Argus host table
;Special treatment for failed search on SU-NET hosts, to look up name using
;SU-ETHERNET (PUP) host number. Note that this code depends on knowing the
;format of SU-Net host numbers (currently class A). Hopefully this code can
;disappear someday, when our host table contains the IP numbers of these hosts.
TDZ 4,[77,,-1] ;Get class-A host number
CAME 4,[NW%SI] ;SU-Net?
JRST HSTNU2 ;No
PUSH 17,0 ;Save original (IP) host number
LDB 4,[201000,,0] ;Get subnet from bits 12-19
DPB 4,[102000,,0] ;Store in bits 20-27, clear 12-19
TLC 0,(NW%SI≠NW%SU) ;Change net number
PUSHJ 17,HSTNUM ;Call ourself!
JRST [ POP 17,0 ;Still failed. Oh well.
JRST HSTNU2] ;Make ASCIZ string for IP host number
POP 17,0 ;Get back IP host number
POP 17,(17) ;Avoid going to GETHDB again
JRST CPOPJ1 ;Skip return to caller of HSTNUM
HSTNU2:
>;repeat 0
;Host not in our host table. Generate ASCIZ string for host number
;instead of name.
MOVEI 1,DHSTST ;Address for ASCIZ host number string
PUSHJ 17,HNUMST ;Preserves 1
SETZM HDBPTR ;no HDB
SETZB 2,3
POPJ 17, ;failure return
;⊗ HSTNAM SEARCH SRCLT SRCGT SRCDUN SRCDU1 SRCDU2 COMPAR PMATCH PMATC1 PMATC2 CHKAMB GOTNAM AMBNAM GETHDB HSTNAB HSTNB1 HSTNB2 HSTNB3 HSTNB4 HSTNB5 HSTUNK HSTUN1 HSTUNA
;HSTNAM -- Return descriptor block for a host name
;Call: MOVEI 0,<pointer to host name string>
; PUSHJ 17,HSTNAM
; <error return--no such host>
; <error return--ambiguous name>
; <return--absolute NUMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2
; next address block in 3>
;Smashes 0 → 11 (!!!).
;Rewritten Apr 86 by JJW. Original code did a linear search through the
;names table and required all-upper-case names in the table. New code
;does binary search since HOSTS3 names table is sorted, and does
;case-insensitive comparisons.
↑HSTNAM:SKIPN 1,HSTADR ;Fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,HSTFIL
FATAL Bad host table
;Set up various AC's for search.
HRLI 0,440700 ;Make byte pointer
MOVE 4,0 ;Set up for HSTNAB
ILDB 2,4 ;Get first char
CAIN 2,"["
JRST HSTNAB ;Parse bracketed host number
MOVE 1,NAMPTR(1)
ADD 1,HSTADR ;Address of NAMES table
HRLI 1,2(1) ;<first entry>,,<addr of table>
ADD 1,(1) ;<first entry>,,<last entry>+1
PUSH 17,1 ;Save for use in SRCDUN
SUBI 1,1 ;<first entry>,,<last entry>
;Host name search. AC's during search hold the following:
; 0: byte pointer to source string
; 1: <beginning>,,<ending> of current range in NAMES table
; 2: current entry in NAMES table being tested
SEARCH: HLRZ 2,1 ;Beginning of current range
CAILE 2,(1) ;Beyond end?
JRST SRCDUN ;Yes, search done
ADDI 2,(1) ;Add beginning and ending
LSH 2,-1 ;Compute midpoint
HRRZ 7,NMRNAM(2)
ADD 7,HSTADR ;Pointer for this entry
HRLI 7,440700
MOVE 6,0 ;Copy of source pointer
PUSHJ 17,COMPAR
JRST SRCGT
JRST SRCLT
JRST [ HLRZ 1,NMLSIT(2) ;Exact match!
ADD 1,HSTADR
ADJSP 17,-1 ;Fix up stack ptr
JRST GOTNAM]
;Fall into SRCLT if partial match
;Here if source string less than table entry.
SRCLT: HRRI 1,-1(2) ;Set end of range to before entry
JRST SEARCH
;Here if source string greater than table entry.
SRCGT: HRLI 1,1(2) ;Set beginning of range to after entry
JRST SEARCH
;Here when binary search done. Unless we got an exact match, we need
;to compare the source against all possible names that might be a partial
;match, to check for ambiguities.
SRCDUN: POP 17,1 ;Get back <first entry>,,<last entry+1>
SUBM 2,1 ;- <Max # of entries to check>
HRL 2,1 ;Make AOBJN ptr
SETZ 3, ;No match yet
SRCDU1: HRRZ 7,NMRNAM(2)
ADD 7,HSTADR ;Pointer for this entry
HRLI 7,440700
MOVE 6,0 ;Copy of source pointer
PUSHJ 17,COMPAR
JRST SRCDU2
JRST CHKAMB ;Done, now check for ambiguity
FATAL Impossible exact match happened in host name lookup
PUSHJ 17,PMATCH ;Handle partial match
SRCDU2: AOBJN 2,SRCDU1
JRST CHKAMB ;Hit end of table
;Subroutine to compare two names given by byte pointers in 6 and 7.
;Returns: +1 if (6) .gt. (7)
; +2 if (6) .lt. (7) and is not a partial match
; +3 if (6) matches (7) exactly
; +4 if (6) matches a substring of (7)
;ACs 10 and 11 hold the most recent characters read from each string.
COMPAR: ILDB 10,6 ;Get next byte from each string
ILDB 11,7
JUMPE 10,[JUMPE 11,CPOPJ2 ;Exact match
AOS (17) ;Partial match
JRST CPOPJ2]
JUMPE 11,CPOPJ ;Partial match the other way
CAIL 10,"a" ;Use upper case for comparisons
SUBI 10,40
CAIL 11,"a"
SUBI 11,40
CAIGE 10,(11)
AOSA (17)
CAILE 10,(11)
POPJ 17,
JRST COMPAR ;Characters match, keep comparing
;Here to handle a partial match. If there was a previous partial match,
;AC 3 contains <flags>,,<HDB ptr>. Bits in <flags> are
; 10 if character after partial match is a "."
; 4 if, in addition, "." is followed by parent of our local domain
; 2 if host is a server
; 1 if ambiguous
;These are set up so that higher-valued combinations are "better" matches
;than lower-valued ones. When a different host with the same bits is
;matched, the ambiguous bit is set. Further matches at the same level
;will be ignored since they now appear worse, but a better match will
;clear the ambiguity bit.
PMATCH: HLRZ 5,NMLSIT(2) ;Set up pointer to HDB
ADD 5,HSTADR
HLLZ 6,STLFLG(5) ;HOSTS3 flags in LH
TLNE 6,STFSRV ;Server?
TRO 6,2 ;Yes, set our flag in RH
CAIE 11,"." ;Subdomain name match?
JRST PMATC2 ;No
TRO 6,10 ;Yes
PUSH 17,6
MOVE 6,[440700,,LOCDOM] ;Our local domain's parent
PUSHJ 17,COMPAR ;Compare with remainder of (7)
JRST PMATC1
JRST PMATC1
JRST [POP 17,6 ↔ TRO 6,4 ↔ JRST PMATC2] ;Exact match, set flag
PMATC1: POP 17,6
PMATC2: HLRZ 4,3 ;Get flags from previous match
SKIPE 3 ;First partial match?
CAIGE 4,(6) ;Or this one better?
JRST [ MOVEI 3,(5) ;Yes, save new host entry
HRLI 3,(6) ;And flags
POPJ 17,]
CAILE 4,(6) ;This one worse?
POPJ 17, ;Yes, keep looking
CAIE 5,(3) ;Bits are equal. Same host?
TLO 3,1 ;No. Set ambiguity flag
POPJ 17,
;Search done, set up HDB ala HSTNUM and return
CHKAMB: JUMPE 3,CPOPJ ;Jump if no match at all
HRRZ 1,3 ;HDB of best match
TLNN 3,1 ;Ambiguous name?
GOTNAM: AOS (17) ;No, set up double skip return
AMBNAM: AOS (17) ;Ordinary skip return
;Routine to get a block of host specifications with pointer in 1.
;;Commented out for now -- won't work with shared upper segment
;; PUSHJ 17,SRTADR ;Sort address list
HRRZ 3,STRADR(1) ;Get address block
ADD 3,HSTADR
MOVE 0,ADDADR(3) ;First address
GETHDB: MOVE 2,STRMCH(1) ;NUMBTS,,NUMMCH
HLL 2,STLFLG(1)
TRNE 2,-1
ADD 2,HSTADR
MOVEM 1,HDBPTR ;Save pointer to HDB
SUB 1,HSTADR
EXCH 1,HDBPTR
HLL 1,STLSYS(1)
HLR 1,STLNAM(1) ;NUMSYS,,NUMNAM
ADD 1,HSTADR ;Relocate right half
TLNN 1,-1
POPJ 17, ;Case of unknown system name
MOVS 1,1
ADD 1,HSTADR ;Relocate left half
MOVS 1,1
POPJ 17, ;And return
;Parse a bracketed specification of the form [a.b.c.d] (IP) or [a#b] (PUP).
HSTNAB: SETZ 0, ;0 will hold result
MOVEI 1,4 ;Number of bytes (assume IP)
HSTNB1: SETZ 2, ;Value of current byte
HSTNB2: ILDB 3,4 ;Get next char
CAIL 3,"0"
CAILE 3,"9"
JRST HSTNB3 ;Non-numeric
IMULI 2,=10
ADDI 2,-"0"(3)
JRST HSTNB2
HSTNB3: CAILE 2,=255 ;Legal byte?
POPJ 17, ;No, lose
LSH 0,=8
ADDI 0,(2) ;Add in current byte
SOJLE 1,HSTNB4 ;Count bytes
CAIN 3,"." ;IP delimiter?
JRST HSTNB1 ;Yes, scan next byte
CAIE 3,"#" ;PUP delimiter?
POPJ 17, ;No, bad format
ADD 0,[NW%SU⊗-=8] ;Yes, set Unternet network number
MOVEI 1,1 ;Scan just 1 more byte
JRST HSTNB1
HSTNB4: JUMPE 3,HSTNB5 ;Allow omission of final delimiter
CAIE 3,"]" ;Last delimiter is different
POPJ 17,
ILDB 3,4 ;Check for garbage at end
JUMPN 3,CPOPJ
HSTNB5: PUSH 17,0
PUSHJ 17,HSTNUM ;Look it up if we can
JRST [ DMOVE 1,HSTUN1 ;Not in table - use dummy data
MOVEI 3,HSTUNA
JRST .+1]
POP 17,0
JRST CPOPJ2
HSTUNK: ASCIZ/unknown/
HSTUN1: HSTUNK,,HSTUNK
0,,HSTUNK
HSTUNA: 0 ;Dummy address block for unknown host
0 ;(so that HSTNXA doesn't lose)
0
;⊗ SRTADR SRTAD1 SRTAD2 SRTAD3 PRIORI PRIOR1 SRTADF
repeat 0,< ;Not currently used (see HSTNAM)
;Sort address list for the site in AC 1, so that programs can try the most
;preferred addresses first. It is better to do this here than to pre-sort
;the host table, because it allows different WAITS sites to share the same
;table, and might still be usable once we switch from tables to domain
;servers.
;We use an O(n↑2) sorting algorithm (bubblesort), and recompute the
;priorities of addresses on each pass, because we never expect to have
;more than a handful of addresses for a single host.
SRTADR: SETZM SRTADF ;Clear flag - no exchanges yet
MOVEI 2,STRADR-ADRCDR(1) ;Make pseudo-address block pointer
HRRZ 3,ADRCDR(2)
ADD 3,HSTADR ;Get first real address block
MOVE 0,ADDADR(3)
PUSHJ 17,PRIORI ;Priority of first address
SRTAD1: MOVE 5,6 ;Save for comparison
HRRZ 4,ADRCDR(3)
JUMPE 4,SRTAD3 ;End of list - see if done
ADD 4,HSTADR ;Next address block
MOVE 0,ADDADR(4)
PUSHJ 17,PRIORI ;Priority of next address
CAML 5,6 ;Need to swap?
JRST SRTAD2
SETOM SRTADF ;Yes, flag a change
HRRZ 0,ADRCDR(4) ;Shuffle pointers
HRRM 0,ADRCDR(3)
SUB 3,HSTADR
HRRM 3,ADRCDR(4)
ADD 3,HSTADR
SUB 4,HSTADR
HRRM 4,ADRCDR(2)
ADD 4,HSTADR
EXCH 5,6 ;Swap priorities correspondingly
SRTAD2: MOVE 2,3 ;Step forward through list
MOVE 3,4
JRST SRTAD1
SRTAD3: SKIPE SRTADF ;Any changes this pass?
JRST SRTADR ;Yes, do another pass
POPJ 17, ;No, all done
PRIORI: MOVSI 7,-NUMPRI
PRIOR1: XOR 0,PRIADR(7) ;Compare with an address
TDNN 0,PRIMSK(7) ;See if any masked bits are different
JRST [ MOVE 6,PRINUM(7);No difference, assign priority
POPJ 17,]
XOR 0,PRIADR(7) ;Restore address
AOBJN 7,PRIOR1
SETZ 6,
POPJ 17,
SRTADF: BLOCK 1 ;Flag for SRTADR
>;repeat 0
;⊗ HSTNXA
; HSTNXA -- Return descriptor block for a host
; Call: MOVE 3,<number return by HSTNAM as next address block>
; PUSHJ 17,HSTNXA
; <error return--no other addresses>
; <return--absolute NAMNUM in 0, next address block in 3>
; Does not disturb 1,2
↑HSTNXA:
SKIPN HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 0,@HSTADR
CAME 0,HSTFIL
FATAL Bad host table
HRRZ 3,ADRCDR(3) ; get other address(es), if any
JUMPE 3,[ SETZ 0, ; if no addresses left, fail
POPJ 17,]
ADD 3,HSTADR
MOVE 0,ADDADR(3) ; get this address
AOS (17)
POPJ 17, ; failure
;⊗ SVCCHK SVCCH1 SVCCH2 SVCCH3
;SVCCHK -- Check address block for a specific service.
;Call: MOVE 3,<number returned by HSTNUM, HSTNAM, or HSTNXA as address block>
; MOVEI 1,[ASCIZ/string to match/]
; PUSHJ 17,SVCCHK
; <return if string not in service list>
; <return if string in service list>
;Preserves 0-3. Smashes 4-10.
↑SVCCHK:
SKIPN HSTADR ;Fail if host table not mapped
FATAL Host table not mapped
HRRZ 4,ADRSVC(3) ;Address of services list
SVCCH1: JUMPE 4,CPOPJ ;No services, or end of list
ADD 4,HSTADR
HRRZ 5,SVRNAM(4) ;Get name of service
ADD 5,HSTADR
HRLI 5,440700 ;Set up byte pointers
MOVSI 6,440701
SVCCH2: ILDB 7,5
ILDB 10,6
JUMPE 7,[JUMPE 10,CPOPJ1 ;Succeed if simultaneous end
JRST SVCCH3] ;Try next if one ends early
JUMPE 10,SVCCH3
CAMN 7,10
JRST SVCCH2 ;Match, keep checking
SVCCH3: HRRZ 4,SVRCDR(4) ;Get next service node
JRST SVCCH1
;⊗ SETANM SETAN1 SETAN2
; SETANM -- Generate alias name from host name
; Call: <call to HSTNUM or HSTNAM to set up HDB pointer>
; PUSHJ 17,SETANM
; Smashes 0 → 3.
IFN HSTSIX,<
↑SETANM:HRLI 1,440700 ;Byte ptr to official name or dotted address
MOVSI 2,440600 ;Byte ptr to output word in 0
SETZ 0,
SKIPN HDBPTR ;Do we have a real HDB?
HRLI 1,350700 ;No, dotted address. Skip over bracket
MOVE 3,(1) ;Get first word of name
TRZ 3,377 ;Check 4 chars
CAME 3,[ASCII/TIP-/] ;Is it "TIP-something"?
CAMN 3,[ASCII/Tip-/] ;Or "Tip-something"?
HRLI 1,100700 ;Yes, skip over "TIP-"
SETAN1: ILDB 3,1 ;Get a character
JUMPE 3,SETAN2 ;Jump if all done
CAIN 3,"."
SKIPN HDBPTR ;Dots are OK in dotted addresses
JRST .+2
JRST SETAN2 ;End name at dot (don't show domain)
CAIN 3,"-"
JRST SETAN1 ;Ignore hyphens
CAIL 3,"a" ;Map lowercase to uppercase
SUBI 3,40
SUBI 3,40 ;Convert ascii to sixbit
IDPB 3,2
TLNE 2,770000 ;Stop after getting one full word
JRST SETAN1
SETAN2: TRNN 0,-1 ;If right half of "alias" is zero,
IORI '.' ; then add a dot to make it "longer"
SETO 1,
GETLIN 1
AOSN 1 ;Don't screw DSK PPN if not a phantom
DSKPPN
POPJ 17,
>; End IFN HSTSIX
repeat 0,< ;Old version
; SETANM -- Generate alias name from host name
; Call: <call to HSTNUM or HSTNAM to set up HDB pointer>
; PUSHJ 17,SETANM
; Smashes 0 → 7 (!!!).
IFN HSTSIX,<
↑SETANM:HRRZ 6,1 ; check official name first (or dotted nbr)
SKIPN 1,HDBPTR
JRST SETA00 ; no host was found, use dotted host nbr
MOVE 2,HSTADR
HRRZ 2,NAMPTR(2) ; get address of NAMES table.
ADD 2,HSTADR
SKIPA 3,(2) ; number of entries in the table.
SETA00: MOVEI 3,0 ; no match earlier, don't look again
SETOB 4,5 ; 4 ← longest name ≤ 6 chars, 5 ← length
AOJA 2,SETAN0 ; skip word 1 of table (entry length)
SETAN1: ADDI 2,1 ; next untried NAMES table entry.
HLRZ 6,(2)
CAME 6,1 ; name the host we are serving?
JRST SETAN4
HRRZ 6,(2) ; how long is this name?
ADD 6,HSTADR
SETAN0: HRLI 6,440700
PUSH 17,6
PUSH 17,6
SETZ 7,
SETAN2: ILDB 6,(17)
SKIPE 6
AOJA 7,SETAN2
POP 17,6 ; flush garbage
POP 17,6 ; restore pointer to name
CAIG 7,6 ; fit in 6 characters?
CAMG 7,4 ; and longer than the previous one?
JRST SETAN4
HRRZ 5,6 ; save name's address
MOVE 4,7 ; and the length
SETAN4: SOJG 3,SETAN1 ; look through the rest of the table.
JUMPGE 4,SETAN5 ; jump if found a reasonable name
MOVEI 4,"-" ; also, will remove hyphens from it
SKIPN 5,HDBPTR
JRST SETAN9 ; no host name at all, using dotted nbr
ADD 5,HSTADR ; no short name, truncate official one
HLRZ 5,STLNAM(5)
ADD 5,HSTADR ; pointer to name
SETAN5: SKIPA 2,5
SETAN9: MOVEI 2,(6) ; ptr to dotted host number string
HRLI 2,440700 ; get BP to name string.
MOVE 1,(2) ; Get beginning of name
TRZ 1,377 ; Check 4 chars
CAME 1,[ASCII/TIP-/] ; Is it "TIP-something"?
CAMN 1,[ASCII/Tip-/] ; Or "Tip-something"?
HRLI 2,100700 ; Yes, skip over "TIP-"
TRZ 1,77777 ; Check 3 chars
CAMN 1,[ASCII/SU-/] ; Is it "SU-something"?
HRLI 2,170700 ; Yes, skip over "SU-"
MOVSI 1,440600
SETZ 0, ; convert name to SIXBIT word in 0
SETAN6: ILDB 3,2
JUMPE 3,SETAN7 ; stop if name string runs out
CAMN 3,4 ; remove hyphens if requested to
JRST SETAN6 ; note 4 has number from 1 to 6 or "-"
CAIL 3,"a"
SUBI 3,40 ;Map to upper case
SUBI 3," "-' '
IDPB 3,1
TLNE 1,770000 ; stop after getting one full word.
JRST SETAN6
SETAN7: LDB 3,1 ; if last character is a hyphen, flush it.
CAIN 3,'-'
SETZ 3,
DPB 3,1
SETAN8: TRNN 0,-1 ; if right half of "alias" is zero,
IORI '.' ; then add a dot to make it "longer"
SETO 1,
GETLIN 1
AOSN 1 ; don't screw DSK PPN if not a phantom
DSKPPN
POPJ 17,
>; End IFN HSTSIX
>;repeat 0
;⊗ HSTNBR IPNBR HSTNBE PUPNBR TXTNUM TXTNU1
;HSTNBR -- Convert numeric text string to host number
;Call: MOVE 0,<addr of text, or byte ptr>
; PUSHJ 17,HSTNBR
; <error--illegal number>
; <return, host number in 1, updated byte ptr in 0>
;Clobbers 2-4.
;Skips over optional leading "[", parses a.b.c.d in decimal (IP address)
;or a#b in octal (PUP address), and skips over optional trailing "]".
↑HSTNBR:TLNN 0,-1
HRLI 0,440700
MOVE 1,0 ;Copy byte ptr
ILDB 2,1 ;Peek at first char
CAIL 2,"0"
CAILE 2,"9"
JRST [ CAIE 2,"[" ;Delimiter?
POPJ 17, ;No, then illegal
MOVE 0,1 ;Skip over delimiter
JRST .+1]
PUSHJ 17,TXTNUM
CAIN 2,"."
JRST IPNBR
CAIN 2,"#"
JRST PUPNBR
POPJ 17,
IPNBR: MOVE 1,3
PUSHJ 17,TXTNUM
CAIE 2,"."
POPJ 17,
LSH 1,=8
ADD 1,3
PUSHJ 17,TXTNUM
CAIE 2,"."
POPJ 17,
LSH 1,=8
ADD 1,3
PUSHJ 17,TXTNUM
LSH 1,=8
ADD 1,3
HSTNBE: CAIN 2,"]"
ILDB 2,0
JRST CPOPJ1
PUPNBR: MOVE 1,4 ;Use octal for PUP
PUSHJ 17,TXTNUM
LSH 1,=8
ADD 1,4
ADD 1,[NW%SU] ;Set "Unternet" network
JRST HSTNBE
;Subroutine to parse digits into a number, both decimal and octal.
TXTNUM: SETZB 3,4 ;Clear both numbers
TXTNU1: ILDB 2,0 ;Get next char
CAIL 2,"0"
CAILE 2,"9"
POPJ 17, ;Not a digit
IMULI 3,=10
ADDI 3,-"0"(2) ;Decimal
IMULI 4,10
ADDI 4,-"0"(2) ;Octal
JRST TXTNU1
;⊗ HNUMST HNUMS1 HNUMS2 HNUMS3 HNUMS5 HNUMSD HNUMSO HNUMSX
;HNUMST -- Generate text string from host number
;Call: MOVE 0,<host number>
; MOVE 1,<address to store text string, or IDPB pointer>
; PUSHJ 17,HNUMST
;Assumes enough space for string and final null byte. (Currently at most =16
;characters.) Smashes 2, 3, and 4 (preserves 0 and 1).
↑HNUMST:PUSH 17,1 ;Save address
TLNN 1,-1 ;Byte ptr in 1?
HRLI 1,440700 ;No, make one
JUMPE 0,HNUMS4 ;Return blank string for address 0
MOVEI 2,"[" ;Start with a bracket
IDPB 2,1
GETNET 4,0 ;Get network number
CAMN 4,[NW%SU] ;Is it the Ethernet?
JRST HNUMS5 ;Yes, generate subnet#host
PUSH 17,[401000,,0] ;Byte ptr to ILDB for host number
JRST HNUMS2
HNUMS1: MOVEI 2,"." ;insert dot between parts of host number
IDPB 2,1 ;stuff into host "name" string (actually host nbr)
HNUMS2: ILDB 2,(17) ;get next byte of host nbr
PUSHJ 17,HNUMSD ;convert to decimal string
MOVE 2,(17)
TLNE 2,770000 ;end of word in byte ptr?
JRST HNUMS1 ;no, output more parts of host nbr
ADJSP 17,-1 ;flush byte ptr from stack
HNUMS3: MOVEI 2,"]" ;end with a bracket
IDPB 2,1
HNUMS4: MOVEI 2,0 ;Terminate host string with a null
IDPB 2,1
POP 17,1 ;Restore original addr
POPJ 17,
HNUMS5: LDB 2,[101000,,0] ;Get subnet number
PUSHJ 17,HNUMSO ;Convert to octal string
MOVEI 2,"#" ;Insert delimiter
IDPB 2,1
LDB 2,[001000,,0] ;Get host number
PUSHJ 17,HNUMSO ;Put in host number string
JRST HNUMS3 ;Finish up
HNUMSD: SKIPA 4,[=10] ;Usual decimal output routine
HNUMSO: MOVEI 4,10 ;Octal output
HNUMSX: IDIV 2,4
HRLM 3,(17)
JUMPE 2,.+2
PUSHJ 17,HNUMSX
HLRZ 3,(17)
ADDI 3,"0"
IDPB 3,1 ;Stick digit into host string
POPJ 17,
;⊗ OURNAM OURNA1
;OURNAM -- Get our host name
;Call: PUSHJ 17,OURNAM
; <error return--can't get our name>
; <return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2,
; address block in 3>
; Smashes 0, 1, 2, 3, and 4.
↑OURNAM:MOVEI 1,355 ;Lowcore ptr to table of host numbers
PEEK 1, ;Get AOBJN ptr
JUMPGE 1,CPOPJ
;Loop thru system table until we find a name
OURNA1: HRRZ 0,1 ;System address of next name in table
PEEK 0, ;Get host number
PUSH 17,1 ;Save AOBJN ptr
PUSHJ 17,HSTNUM
JRST [ POP 17,1 ;Failed
AOBJN 1,OURNA1 ;Try next number
POPJ 17,] ;Lose if we tried them all
POP 17,(17) ;Flush AOBJN ptr
JRST CPOPJ1
;⊗ ATTHST ATTHS0 ATTHS2 ATTCRE ATTMUL ATTUPP ATTLOW ATTERR MXATTE HSGNAM
;ATTHST -- Attach to upper segment that has the host table in it,
; or create one if necessary.
;Call: PUSHJ 17,ATTHST
; <return>
;Preserves ALL ACs.
↑ATTHST:PUSH 17,3 ;preserve all ACs
MOVE 3,HSGNAM ;get upper segment name
ATTHS0: ATTSEG 3, ;try to attach to segment
JRST ATTHS2 ;failed, see why
MOVEI 3,400000
MOVEM 3,HSTADR ;set host table address
POP 17,3
POPJ 17,
ATTHS2: HLLM 3,-1(17) ;save error code's left half
ANDI 3,-1 ;just error code
CAIL 3,MXATTE ;reasonable error?
MOVEI 3,MXATTE ;no
JRST @ATTERR(3) ;dispatch on error
;Create upper segment and read host table into it.
ATTCRE: PUSH 17,0
PUSH 17,1
PUSH 17,2
PUSHJ 17,MAPHS2 ;read host table into new upper segment, AC 3 already saved
MOVEI 1,1
SETUWP 1, ;write protect upper segment
JFCL ;error should never happen
MOVE 1,HSGNAM
SETNM2 1, ;rename it so others can share it
JFCL ;error should never happen
POP 17,2
POP 17,1
POP 17,0
POP 17,3
POPJ 17,
;Attach one of multiple uppers with same name
ATTMUL: HLRZ 3,-1(17) ;job number of one job with given name
JRST ATTHS0 ;try again
ATTUPP: FATAL ATTHST called with existing upper segment in use.
ATTLOW: FATAL ATTHST called with lower segment bigger than 128K.
ATTERR: ATTCRE ;protection violation, create new segment
ATTMUL ;multiple upper segments, attach one
ATTCRE ;no such upper segment job number
ATTCRE ;no such upper segment job name
ATTUPP ;already have an upper
ATTLOW ;lower segment is too big
MXATTE←←.-ATTERR
↑HSGNAM:SIXBIT/HOSTS!/ ;name of upper segment
;⊗ DETHST
;DETHST -- Detach upper segment (that has host table in it, presumably).
;Call: PUSHJ 17,DETHST
; <return>
;Preserves ALL ACs.
↑DETHST:SETZM HSTADR ;no more host table in upper
;; DETSEG 1, ;detach upper but don't let it go away when we're RESET
PUSH 17,0
MOVEI 0,0
CORE2 0, ;Release upper segment
JFCL ;Impossible error
POP 17,0
POPJ 17,
>; End IFN HSTTAB
;⊗ B%ADDRESS B%EXISTS B%DEFL VERSIO BLKSIZ NETADR NUMTTY DEFBLK TTYBLK TTYSTR TTYST1 CPYNAM CPYNA1 TTYST9 TTYREA TTYRE1
;TTYSTR -- Get TTY location string for SU-Ethernet host
;Call: MOVE 1,[BYTE(2)0(8)net,host(18)line]
; PUSHJ 17,TTYSTR
; <error return - not in table>
; <success, byte ptr to TTY location string in 1>
;Smashes 0-4. Temporarily uses one page of core above JOBFF (allocating
;if necessary, but not deallocating), and I/O channel 0. FINGER and maybe
;other programs allocate their own core and fake JOBFF before calling here.
IFN TTYSTS,<
COMMENT \
[Copied from <FINGER.SOURCES>TINIDF.MAC at Score. Watch out for unannounced
changes in the format of the TTYINI.BIN files. Note: we don't currently use
the "default" information for hosts.
If changing this code, recompile: CHTSER (PUP001), ARPSER (PUP131),
NETFNG (FINGER).]
TTYINI.NET-BIN File format:
Page 0:
Word 0: TTYINI version number of file (VERSION).
Word 1: Size of blocks in TTYINI entries (BLKSIZ).
Words 2-511: Net pointers, indexed by net number. Each pointer
points to a page (called a NET page) in the file.
A word of all ones is a null pointer (symbolic address
NETADR).
NET pages (mapped at NETPAG):
Words 0-511: Host pointers, indexed by host number. These pointers
point to the TTYINI data for each host, and are page
numbers (HOST pages). A word of all ones is a null
pointer (symbolic address NETPGA). If not -1 but the
left half is nonzero then this is a pointer to another
host.
HOST pages (mapped at HSTPAG):
Word 0: Number of TTYINI blocks for this host (number of lines on
host, symbolic name NUMTTY).
Words 1-end: TTYINI blocks (TTYBLK).
TTYINI blocks:
Each line has an associated terminal block of the following format:
TYPE
ttynumber = RECORD (* TTYNumber *)
NetNumber,
HostNumber: 9bit integer unsigned;
LineNumber: short integer unsigned;
END (* TTYNumber is a word of net, host,, line number *)
directiontype = (toleft, toright, acrossglass, facing,
diagonally-opposite, behind, acrosspartition, unused);
(* For fing/neighbor *)
locationtype = (ceras105, ceraslobby, cerasother, terman104,
termanother, termanlobby, dialin, gandalf, ethernvt,
arpanvt, decnvt, internetnvt, pty, erl206, meyer,
larkin); (* Typical locations *)
flagtype = (consultant, assignable, overhead, formfeed, lowercase,
tabs, pagepause, commandpause, raise, flag);
tty = RECORD (* Tty *)
ttytype, (* Terminal type number, or -1 if ? *)
defttytype, (* Default type number or -1 if ? *)
length, (* Terminal length or -1 if ? *)
width: integer; (* Terminal width or -1 if ? *)
(* Total 4 wds *)
address: PACKED ARRAY[1..30] OF char;
(* String for finger. 6 wds *)
location: locationtype; (* Where it is for finger. 1 wd *)
neighbors: PACKED ARRAY [directiontype] OF ttynumber;
(* For FINGER/NEIGHBORS. 8 wds *)
dplxmode: (fullduplex, noduplex, halfduplex, linehduplex);
(* 1 wd *)
bits: PACKED SET OF flagtype;
(* Bits. 2 wds currently *)
print-node: PACKED ARRAY [1..10] OF char;
(* 6 letter DECnet node name. 2 wds *)
END (* Tty *) (* 24 words, currently *)
\
;Constants we need
B%ADDRESS==4 ;Index of address string
B%EXISTS==33 ;Index of word which is 0 if entry exists, else -1
B%DEFL==34 ;Length of default TTYINI block
;Page 0 of TTYINI.NET-BIN
VERSIO==0 ;Version number of TTYINI.NET-BIN
BLKSIZ==1 ;Size of each TTY's block
NETADR==2 ;Table of network page pointers
;Host pages
NUMTTY==0 ;Number of lines on host
DEFBLK==1 ;Default TTYINI block for this host
TTYBLK==1+B%DEFL ;Start of TTYINI data for host
↑TTYSTR:
PUSH 17,1 ;Save argument
INIT 0,17
('DSK')
0
FATAL DSK INIT failure
DMOVE 0,TTYFIL
MOVE 3,TTYPPN
LOOKUP
JRST TTYST9 ;Return quietly if file not there
MOVE 4,JOBFF↑ ;Start of one-page data area
;AC 4 will hold this value from now on.
MOVEI 0,777(4) ;Highest address in page
CAMG 0,JOBREL↑ ;Do we have enough core?
JRST TTYST1 ;Yes
CORE 0, ;No, get more
FATAL CORE UUO failure
TTYST1: MOVEI 1,0 ;Get page 0
PUSHJ 17,TTYREA
MOVE 0,BLKSIZ(4) ;Copy blocksize while we have it here
MOVEM 0,TTBSIZ
LDB 1,[321017,,0] ;Network number
ADDI 1,NETADR(4) ;Index into list of pages
SKIPN 1,(1) ;File page for network
JRST TTYST9 ;Unknown network
PUSHJ 17,TTYREA ;Read network page
LDB 1,[221017,,0] ;Host number
ADDI 1,(4) ;Index into list of pages
SKIPG 1,(1) ;File page for host
JRST TTYST9 ;Unknown host
TLNE 1,-1 ;Pointer to another host?
JRST TTYST9 ;Yes, deal with this later
MOVE 3,1 ;Remember page number
PUSHJ 17,TTYREA ;Read first page of host info
HRRZ 1,(17) ;Line number
CAMLE 1,NUMTTY(4) ;Compare with max for this host
MOVEI 1,0 ;Out of range: use name for line 0
IMUL 1,TTBSIZ ;Offset of TTY info block
ADDI 1,TTYBLK ;Skip header preceding first block
MOVEI 2,-1(1)
ADD 2,TTBSIZ ;Offset of last word in block
CAIG 2,777 ;Is block within page 0?
JRST CPYNAM ;Yes, we have it
PUSH 17,1 ;Remember start of block
XOR 2,1
TRNE 2,777000 ;Are start and end within same page?
JRST [ LSH 1,-=8 ;No, get 1/2 pages before and after start
LSH 1,1
LSH 3,2 ;File addr of first page of host info
ADD 1,3
PUSHJ 17,TTYRE1
POP 17,1
ANDI 1,377 ;New offset
JRST CPYNAM]
LSH 1,-=9 ;Get page containing entire block
ADD 1,3
PUSHJ 17,TTYREA
POP 17,1
ANDI 1,777
CPYNAM: ADDI 1,(4) ;Start of block for this line
SKIPE B%EXISTS(1) ;Skip if entry exists
JRST TTYST9 ;No entry, return failure
CPYNA1: MOVSI 2,B%ADDRESS(1) ;Start of terminal location string
HRRI 2,TTYNAM ;Place to copy it to
BLT 2,TTYNAM+5 ;Copy 6 words
AOS -1(17) ;Set skip return
MOVE 1,[440700,,TTYNAM] ;Set return value
TTYST9: RELEAS ;Give up I/O channel
ADJSP 17,-1 ;Flush argument
POPJ 17,
;Subroutine to read a page of the binary file.
TTYREA: LSH 1,2 ;Convert pages to disk records
TTYRE1: USETI 0,1(1) ;First record is 1
MOVEI 0,-1(4) ;Construct IOWD
HRLI 0,-1000
SETZ 1, ;End IOWD list
INPUT 0,0
POPJ 17,
>;End IFN TTYSTS
;Domain resource record format ;⊗
IFN DOMRTS,< ;First of several pages
;Resource records read from or written to the system cache are stored
;in the following format (36-bit words):
;
; +-----------------------------------------------------------------------+
; | TYPE |
; +-----------------------------------------------------------------------+
; | CLASS |
; +-----------------------------------------------------------------------+
; | TIME TO LIVE (in seconds) |
; +-----------------------------------------------------------------------+
; | DATA LENGTH (or immediate data) |
; +---------------+---------------+---------------+---------------+-------+
; | | |
; | DOMAIN NAME, followed by DATA (in 8-bit bytes) | |
; | | |
; +---------------+---------------+---------------+---------------+-------+
;
;The domain name is a sequence of components, each having a length byte
;followed by that many bytes of characters. A zero length byte terminates
;the string. It is followed by data, whose format may depend on the type
;and class of the record. If the data is known to fit in one word, it is
;stored in place of the data length. (For Internet addresses, it is 32
;bits right-aligned in the word.)
;A negative data length means a reply was received indicating that the
;requested data does not exist (e.g., the name is unknown). These records
;are cached to avoid repeated queries for nonexistent information.
;Messages sent to or received from name servers follow the format in RFC
;883, as modified in RFC 973. Each message has five sections:
;
; +---------------------+
; | Header |
; +---------------------+
; | Question | the question for the name server
; +---------------------+
; | Answer | answering resource records (RRs)
; +---------------------+
; | Authority | RRs pointing toward an authority
; +---------------------+
; | Additional | RRs holding pertinent information
; +---------------------+
;
;There are no padding bytes, so after the header we cannot assume the
;alignment of any fields in such a message.
;
;The header is 12 bytes (shown here in 16-bit words; we store these two
;per word, left-aligned):
;
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | ID |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; |QR| Opcode |AA|TC|RD|RA| | RCODE |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | QDCOUNT |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | ANCOUNT |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | NSCOUNT |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | ARCOUNT |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;
;The question section looks as follows:
;
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | |
; / QNAME /
; / /
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | QTYPE |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | QCLASS |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;
;QNAME is in the 8-bit format described above, except that it may be
;"compressed" by including pointers to previous name components. See RFC
;883 for details.
;
;The other sections contain 0 or more resource records (given by the
;counts in the header). A resource record looks like
;
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | |
; / /
; / NAME /
; | |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | TYPE |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | CLASS |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | |
; + TTL +
; | |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
; | RDLENGTH |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--|
; / RDATA /
; / /
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
;
;NAME is in the 8-bit compressed format, as is RDATA if it is a domain
;name. RDLENGTH is the length (in bytes) of RDATA.
;⊗ RRTYPE RRCLAS RRTTL RRDLEN RRNAME TY.A TY.NS TY.CNAME TY.SOA TY.MB TY.MG TY.MR TY.NULL TY.WKS TY.PTR TY.HINFO TY.MINFO TY.MX TY.AXFR TY.MAILB TY.ALL CL.IN CL.CH CL.ALL DOM NETIBF NETOBF DOMIBF DOMOBF NETBFL DOMBFL NETBUF DOMBUF DVERBOSE UPCASE AUTHOR NODFLT MXPREF OSNAME BLKLEN DLKBLK DLKNME NAMBLK DATBLK DATPTR MXDBLK MXHBLK MXABLK MXAPTR MXPBLK MXPPTR SETUDP QUERYB QDCOUNT ANCOUNT NSCOUNT ARCOUNT TEMPBP TTLMIN TTLMAX TTLNME TTLSFE NODOTS DFLTDM CNAMEC
;Resource record format as stored in system cache. Data follows name,
;unless (based on RRTYPE and RRCLAS) it is stored in RRDLEN word.
RRTYPE←←0 ;Type
RRCLAS←←1 ;Class
RRTTL←←2 ;Time to live (in seconds)
RRDLEN←←3 ;Data length (in bytes), or immediate data
RRNAME←←4 ;Start of name
;Resource record types
↑TY.A←←=1 ;Internet address
↑TY.NS←←=2 ;Name server
;↑TY.MD←←=3 (obsolete) ;Mail destination
;↑TY.MF←←=4 (obsolete) ;Mail forwarder
↑TY.CNAME←←=5 ;Canonical name
↑TY.SOA←←=6 ;Start of authority
↑TY.MB←←=7 ;Mailbox
↑TY.MG←←=8 ;Mail group
↑TY.MR←←=9 ;Mail rename
↑TY.NULL←←=10 ;Null
↑TY.WKS←←=11 ;Well-known service
↑TY.PTR←←=12 ;Pointer
↑TY.HINFO←←=13 ;Host information
↑TY.MINFO←←=14 ;Mail information
↑TY.MX←←=15 ;Mail exchange
;Query types (in addition to above)
↑TY.AXFR←←=252 ;Zone of authority transfer
↑TY.MAILB←←=253 ;MAILB Mailbox-related records
;↑TY.MAIA←←=254 (obsolete) ;(MAILA) Mail agent records
↑TY.ALL←←=255 ;All types
;Resource record classes
↑CL.IN←←=1 ;Internet
;↑CL.CS←←=2 (obsolete) ;CSNET
↑CL.CH←←=3 ;Chaos
;Query classes (in addition to above)
↑CL.ALL←←=255 ;All classes
DOM←←2 ;Channel for domain cache
;Buffer headers
NETIBF: BLOCK 3
NETOBF: BLOCK 3
DOMIBF: BLOCK 3
DOMOBF: BLOCK 3
;Space for the buffers themselves. For each device we have 1 input and 1
;output buffer. We allocate them here to avoid expanding core, mainly for
;the benefit of MAIL.
NETBFL←←200 ;Length of data in NET buffers
DOMBFL←←200 ;Length of data in DOM buffers
NETBUF: BLOCK 2*<NETBFL+3>
DOMBUF: BLOCK 2*<DOMBFL+3>
↑DVERBOSE:-1 ;0 to supress some typeout
↑UPCASE:-1 ;0 to not convert names to upper case
↑AUTHOR:0 ;-1 to force authoritative answer
↑NODFLT:0 ;-1 to disable appending default domain
↑MXPREF:0 ;preference value in MX record
↑OSNAME:0 ;OS name in HINFO record
BLKLEN←←100 ;Length of various blocks
DLKBLK: BLOCK BLKLEN ;Domain LOOKUP block
DLKNME: BLOCK 1 ;Pointer to end of name in DLKBLK
NAMBLK: BLOCK BLKLEN ;Block for returned name
DATBLK: BLOCK BLKLEN ;Block for returned data
DATPTR: BLOCK 1 ;Pointer used to fill DATBLK
IFN MXRTS,<
MXDBLK: BLOCK BLKLEN ;Name of target domain
MXHBLK: BLOCK BLKLEN ;Name of mail exchange host
MXABLK: BLOCK BLKLEN ;List of addresses
MXAPTR: BLOCK 1 ;Ptr into MXABLK
MXPBLK: BLOCK BLKLEN ;List of corresponding priorities
MXPPTR: BLOCK 1 ;Ptr into MXPBLK
>;IFN MXRTS
SETUDP: 26 ;MTAPE block for UDP parameters
0 ;Status bits
0 ;Local port
0
0
=53 ;Remote domain server port
0 ;Remote address
;Message header (12 bytes) for domain server query
QUERYB: BYTE (8)0,0,1,0 ;ID, flags (recursion desired)
BYTE (8)0,1,0,0 ;QDCOUNT, ANCOUNT
BYTE (8)0,0,0,0 ;NSCOUNT, ARCOUNT
QDCOUNT:0 ;Storage for RDRESP
ANCOUNT:0
NSCOUNT:0
ARCOUNT:0
TEMPBP: 0
TTLMIN: =60 ;1 min ;Minimum TTL for records we give system
TTLMAX: =48*=60*=60 ;48 hr ;Maximum TTL for records we give system
TTLNME: =4*=60*=60 ;4 hr ;TTL for cached name errors
TTLSFE: =20*=60 ;20 min ;TTL for cached soft errors
NODOTS: 0
DFLTDM: ASCIZ/Stanford.EDU/ ;Default domain string
CNAMEC: BLOCK 1 ;CNAME count (to prevent loops)
;⊗ SUCCES NICKNM SFTERR NAMERR GETDOM GETDO1 GETDO2 GETDO3 GETDO5 GETDO6 GETDMA GETINP GETIN1 GETIN2 GETIN3 GETIN4 GT.UNK GTDISP GT.MAX GT.A GT.RET GT.MX GT.DOM GT.DO1 GT.DO2 GT.DO3 GT.WKS GT.HIN GT.HI1 GT.HI2
;Get domain information. Calling sequence:
;
; MOVE 0,[<addr or byte ptr to ASCIZ domain name>]
; MOVE 1,[<query type>]
; MOVE 2,[<query class>]
; PUSHJ 17,GETDOM
; <name error: requested information does not exist>
; <soft error: requested information not available>
; <nickname was given: AC 3 points to canonical name>
; <success, 0 contains addr of domain name,
; 1 contains type,
; 2 contains class,
; 3 contains data>
;
;Several flags can be set to affect processing:
; AUTHOR if non-0, always send a network query to get authoritative
; information before checking system cache
; NODFLT if non-0, don't append a default domain to names not
; containing any "." characters.
;
;After a successful return, to get further answers:
;
; PUSHJ 17,GETDMA
; <no more information>
; <success, 0-3 contain same as above>
;
;The returned domain name pointed to by AC 0 may differ in capitalization,
;otherwise it is expected to be the same as the query domain name. The
;format of the data returned in AC 3 depends on the type in AC 1, as follows:
;
; TY.A AC 3 contains the 32-bit address.
; TY.SOA Not implemented
; TY.NULL Not implemented
; TY.WKS AC 3 points to a block organized as follows:
; Word 0/ 32-bit IP address (right-aligned)
; Word 1/ Internet protocol number
; Word 2/ Number of bytes in bit map
; Bit map of well-known services
; TY.HINFO AC 3 points to an ASCIZ string for the CPU name,
; location OSNAME points to an ASCIZ string for the OS name.
; TY.MINFO Not implemented
; TY.MX AC 3 points to an ASCIZ string for a host name,
; location MXPREF contains the preference value
; Others AC 3 points to an ASCIZ string representing a domain name
;
;If the original name is found to be a nickname, you should call GETDOM
;again with the canonical name that was returned. It is safe to copy AC 3
;into 0 (and reset the type in AC 1).
;
;A name error means a server told us the information does not exist for
;the requested domain. A soft error means we could not get to a server,
;so retrying later may work.
;Return addresses restore ACs saved on entry and skip appropriately.
SUCCES: AOS -1(17) ;Success
NICKNM: AOS -1(17) ;Nickname
SFTERR: AOS -1(17) ;Soft error
NAMERR: POP 17,4 ;Name error
POPJ 17,
↑GETDOM:PUSH 17,4 ;Save some ACs
;Prepare lookup block
MOVEM 1,DLKBLK+RRTYPE
MOVEM 2,DLKBLK+RRCLAS
;Convert name argument from ASCIZ to domain format
TLNN 0,-1 ;Byte ptr?
HRLI 0,440700 ;No, make one
MOVE 2,[POINT 8,DLKBLK+RRNAME] ;Destination byte ptr
SETOM NODOTS ;No "." seen yet
PUSH 17,UPCASE ;We may clobber this
GETDO1: SETZ 4, ;Component length ← 0
IBP 2 ;Skip length byte
MOVE 3,2 ;Save ptr to length byte
GETDO2: ILDB 1,0 ;Get a byte
JUMPE 1,GETDO5 ;Jump if end of string
CAIN 1,"." ;End of component?
JRST [ SETZM NODOTS ;Yes, now we've seen a "."
DPB 4,3 ;Store length byte
JRST GETDO1] ;Start next component
SKIPN UPCASE ;Convert letters to upper case?
JRST GETDO3 ;No
;This is for servers that return name in the same form we send it.
CAIL 1,"a"
CAILE 1,"z"
CAIA
SUBI 1,"a"-"A"
GETDO3: IDPB 1,2 ;Copy byte to domain string
AOJA 4,GETDO2
GETDO5: DPB 4,3 ;Store length byte
SKIPE NODOTS ;If we've seen a "."
SKIPE NODFLT ; or if no defaulting wanted
JRST GETDO6 ; then we're done
MOVE 0,[440700,,DFLTDM] ;Else point to default domain
SETZM NODOTS
SETZM UPCASE
JRST GETDO1 ;Add it to string
GETDO6: IDPB 1,2 ;End with 0 length byte
MOVEM 2,DLKNME ;Save ptr to end of name
POP 17,UPCASE
INIT DOM,0 ;Open domain device
SIXBIT/DOM/
DOMOBF,,DOMIBF
FATAL Domain device INIT failure
MOVEI 0,DOMBUF ;Allocate buffers
EXCH 0,JOBFF↑
INBUF DOM,1
OUTBUF DOM,1
OUTPUT DOM, ;Set up first output buffer
MOVEM 0,JOBFF↑
SKIPN AUTHOR ;Force query if authority desired
LOOKUP DOM,DLKBLK ;See if data in system
JRST [ PUSHJ 17,SQUERY ;Not found, ask a server
LOOKUP DOM,DLKBLK ;Check system cache again
JRST SFTERR ;Still nothing there
JRST .+1]
;System has information, read it
PUSHJ 17,GETINP ;Read RR, return data in ACs
JRST NAMERR ;Name error
JRST SFTERR ;Soft error
FATAL Domain device input failure
CAIN 1,TY.CNAME ;Skip unless returning a CNAME
CAIN 1,DLKBLK+RRTYPE ;Did he ask for a CNAME?
JRST SUCCESS ;Give standard return
JRST NICKNM ;No, indicate nickname
↑GETDMA:PUSH 17,4
PUSHJ 17,GETINP
JFCL ;Name error
JFCL ;Soft error
SOS -1(17) ;No input data
POP 17,4
JRST CPOPJ1
;GETINP reads one input record from the system. Calling sequence:
;
; PUSHJ 17,GETINP
; <name error>
; <soft error>
; <no data available>
; <success, ACs 0-3 contain return data>
;
;Return data is same as for GETDOM.
GETINP: IN DOM, ;Get the data
JRST .+2
JRST CPOPJ2 ;Input failed, no more data
MOVE 1,DOMIBF ;Buffer pointer
ADDI 1,2 ;Point to resource record
SKIPL 2,RRDLEN(1) ;Cached error?
JRST GETIN1 ;No
CAMN 2,[-2] ;Soft error?
AOS (17) ;Yes, skip once
POPJ 17, ;No, assume name error
;Copy the name in the reply into NAMBLK.
GETIN1: MOVE 2,[POINT 8,RRNAME(1)]
MOVE 0,[POINT 7,NAMBLK]
GETIN2: ILDB 3,2 ;Get a length byte
JUMPE 3,GETIN4
GETIN3: ILDB 4,2 ;Get a data byte
IDPB 4,0 ;Copy it
SOJG 3,GETIN3
MOVEI 4,"." ;End a name component
IDPB 4,0
JRST GETIN2
GETIN4: DPB 3,0 ;Replace last "." with null
MOVE 3,RRTYPE(1) ;Examine type
CAIGE 3,GT.MAX ;Bounds check
JRST @GTDISP(3) ;Dispatch based on type
;Unknown record type - shouldn't happen since READRR only stores known types.
GT.UNK: FATAL Unknown domain record read from system
GTDISP: GT.UNK
GT.A ;TY.A
GT.DOM ;TY.NS
GT.DOM ;TY.MD (obsolete)
GT.DOM ;TY.MF (obsolete)
GT.DOM ;TY.CNAME
GT.UNK ;TY.SOA
GT.DOM ;TY.MB
GT.DOM ;TY.MG
GT.DOM ;TY.MR
GT.UNK ;TY.NULL
GT.WKS ;TY.WKS
GT.DOM ;TY.PTR
GT.HIN ;TY.HINFO
GT.UNK ;TY.MINFO
GT.MX ;TY.MX
GT.MAX←←.-GTDISP
GT.A:
repeat 0,< ;Compatibility code for addresses stored in RRDLEN
MOVE 3,RRDLEN(1) ;Get length field
TLNE 3,-1 ;Is left half non-zero?
JRST GT.RET ;Yes, this is the address
>;repeat 0
MOVE 0,[POINT 8,3,3] ;Byte ptr to store address
REPEAT 4,<
ILDB 4,2 ;Copy an address byte
IDPB 4,0
>;REPEAT 4
GT.RET: MOVE 2,RRCLAS(1) ;Set up ACs 0-2 for return
MOVE 1,RRTYPE(1)
MOVEI 0,NAMBLK
JRST CPOPJ3 ;Skip thrice for success
GT.MX: ILDB 3,2 ;Get 1st byte of MX preference
ILDB 4,2 ; and 2nd
LSH 3,=8 ;Combine them
ADDI 3,(4)
MOVEM 3,MXPREF
;fall into GT.DOM to read MX domain name
GT.DOM: MOVE 0,[POINT 7,DATBLK] ;Init destination ptr
GT.DO1: ILDB 3,2 ;Get a length byte
JUMPE 3,GT.DO3
GT.DO2: ILDB 4,2 ;Copy a character
IDPB 4,0
SOJG 3,GT.DO2
MOVEI 4,"." ;End a name component
IDPB 4,0
JRST GT.DO1
GT.DO3: DPB 3,0 ;Replace last "." with null
MOVEI 3,DATBLK ;Point to returned data
JRST GT.RET
GT.WKS: JRST GT.UNK
;HINFO data is 1 byte CPU name length, CPU name, 1 byte OS name length,
;OS name.
GT.HIN: MOVE 0,[POINT 7,DATBLK]
ILDB 3,2 ;CPU name length
GT.HI1: ILDB 4,2 ;Copy a character
IDPB 4,0
SOJG 3,GT.HI1
MOVEI 4,0 ;End with a null
IDPB 4,0
ADDI 0,1 ;Point to next word
HRRZM 0,OSNAME
HRLI 0,440700
ILDB 3,2 ;OS name length
GT.HI2: ILDB 4,2 ;Copy a character
IDPB 4,0
SOJG 3,GT.HI2
MOVEI 4,0 ;End with a null
IDPB 4,0
MOVEI 3,DATBLK ;Point to CPU name
JRST GT.RET
;⊗ SQUERY UNKERR FMTERR SRVFAI NOTIMP REFUSE RDRESP SKIPQR SKIPQ1 RDANS RDAUTH RDADDL NAMERX SFTERX CACHER SQURET
;Send query to domain server, using info in DLKBLK, and store into
;system cache any domain records received, or error records.
SQUERY: IOPUSH NET,'NET'
FATAL IOPUSH failed
INIT NET,0 ;Open network channel
SIXBIT/IMP/
NETOBF,,NETIBF
FATAL Network device INIT failure
MOVEI 0,NETBUF ;Allocate buffers
EXCH 0,JOBFF↑
INBUF NET,1
OUTBUF NET,1
MOVEM 0,JOBFF↑
MOVEI 1,=8 ;Set byte size in buffer headers
DPB 1,[POINT 6,NETIBF+1,11]
DPB 1,[POINT 6,NETOBF+1,11]
MTAPE NET,[17 ↔ 0,,001200] ;Set 20-second input timeout
SETOM SETUDP+2 ;Let system allocate local port
MOVE 1,[4416,,000227] ;(Argus)
;; MOVE 1,[4405,,200024] ;(Jessica)
;; MOVE 1,[4402,,000057] ;(Labrea)
MOVEM 1,SETUDP+6 ;Set server address
MTAPE NET,SETUDP
OUTPUT NET, ;Set up first output buffer
MOVE 1,SETUDP+2 ;Get the port we were assigned
DPB 1,[POINT 16,QUERYB,15] ;Use it as the ID byte
MOVE 1,NETOBF ;Output buffer pointer
ADDI 1,2 ;First data word
HRLI 1,QUERYB ;Set up to copy query block
BLT 1,2(1) ;Copy three header words
MOVE 0,DLKBLK+RRTYPE
HRLI 1,DLKBLK+RRNAME ;Start of name to copy
MOVE 2,DLKNME ;Ptr to last byte in source
SUBI 2,DLKBLK+RRNAME ;RH ← length of name in words
ADDI 2,(1) ;Ptr to last byte in destination
MOVEM 2,NETOBF+1 ;Store ptr in buffer header
BLT 1,(2) ;Copy name
MOVE 1,DLKBLK+RRTYPE ;Copy type from lookup block
ROT 1,-=8
IDPB 1,NETOBF+1
ROT 1,=8
IDPB 1,NETOBF+1
MOVE 1,DLKBLK+RRCLAS ;Copy class
ROT 1,-=8
IDPB 1,NETOBF+1
ROT 1,=8
IDPB 1,NETOBF+1
OUT NET, ;Send the query
CAIA ;Output OK
JRST SFTERX ;Output error (probably server unreachable)
IN NET, ;Wait for response
CAIA ;Input OK
JRST SFTERX ;Time out or other error
MOVEI 1,=16 ;Temporarily change byte size
DPB 1,[POINT 6,NETIBF+1,11]
ILDB 1,NETIBF+1 ;ID field
;Don't bother checking ID for now. What would we do if it was wrong?
ILDB 1,NETIBF+1 ;Opcode and Flags
ILDB 2,NETIBF+1 ;Read and store other header fields
MOVEM 2,QDCOUNT
ILDB 2,NETIBF+1
MOVEM 2,ANCOUNT
ILDB 2,NETIBF+1
MOVEM 2,NSCOUNT
ILDB 2,NETIBF+1
MOVEM 2,ARCOUNT
MOVEI 2,=8 ;Back to 8-bit bytes
DPB 2,[POINT 6,NETIBF+1,11]
;Various flags in 1 should be checked.
ANDI 1,17 ;Dispatch on RCODE field
CAILE 1,5 ;Highest reply code we know
JRST UNKERR
JRST @[ RDRESP ;No error, read response
FMTERR ;Format error
SRVFAI ;Server failure
NAMERX ;Name error
NOTIMP ;Not implemented
REFUSE](1) ;Refused
UNKERR: OUTSTR [ASCIZ/Unknown domain error code.
/]
JRST NAMERX ;Treat as name error
FMTERR: OUTSTR [ASCIZ/Domain format error.
/]
JRST NAMERX
;These errors sometimes happen so treat as a temporary failure.
SRVFAI: OUTSTR [ASCIZ/Server failure.
/]
JRST SFTERX
NOTIMP: OUTSTR [ASCIZ/Domain not implemented error.
/]
JRST NAMERX
REFUSE: OUTSTR [ASCIZ/Query refused.
/]
JRST SFTERX
;Read response from server, and store all of the resource records in the
;response into the system cache. These will then be used to answer the
;original query.
;Skip over question section. (We assume it matches the query.)
;QDCOUNT should always be 1, but we don't assume it.
RDRESP: SOSGE QDCOUNT ;Skip unless done question section
JRST RDANS
SKIPQR: ILDB 1,NETIBF+1 ;Get a length byte
JUMPE 1,SKIPQ1 ;Jump at end of QNAME
TRZE 1,300 ;Compressed format?
JRST [ IBP NETIBF+1 ;Yes, this makes it easy to skip over!
JRST SKIPQ1]
IBP NETIBF+1 ;Skip over that many bytes
SOJG 1,.-1
JRST SKIPQR
SKIPQ1: AOS NETIBF+1 ;Skip 4 bytes (type and class)
JRST RDRESP
;Read resource records from answer section.
RDANS: SOSGE ANCOUNT ;Skip unless done answer section
JRST RDAUTH
PUSHJ 17,READRR ;Read a resource record
JRST RDANS
;Read resource records from authority section.
RDAUTH: SOSGE ANCOUNT ;Skip unless done authority section
JRST RDADDL
PUSHJ 17,READRR ;Read a resource record
JRST RDAUTH
;Read resource records from additional section.
RDADDL: SOSGE ANCOUNT ;Skip unless done additional section
JRST SQURET
PUSHJ 17,READRR ;Read a resource record
JRST RDADDL
;Here to make up a cache entry for name error or soft error, to avoid
;querying server for this error repeatedly.
NAMERX: SETOM DLKBLK+RRDLEN ;Indicate name error
MOVE 1,TTLNME ;Set its TTL
JRST CACHER
SFTERX: MOVE 1,[-2] ;Indicate soft error
MOVEM 1,DLKBLK+RRDLEN
MOVE 1,TTLSFE ;Set its TTL
CACHER: MOVEM 1,DLKBLK+RRTTL
MOVE 1,DLKBLK+RRTYPE ;Get type
CAIL 1,RD.MAX ;Make sure it's reasonable (not TY.ALL)
JRST SQURET ;If not, just return
MOVE 1,DOMOBF ;Output buffer pointer
ADDI 1,2 ;First data word
HRLI 1,DLKBLK ;Addr of our query
MOVE 2,DLKNME ;Ptr to last byte in query
ADDI 2,-DLKBLK(1) ;Ptr to last byte in destination
BLT 1,(2) ;Copy the query
MOVEM 2,DOMOBF+1 ;Store final byte ptr for output
OUTPUT DOM, ;Send record to system cache
SQURET: RELEAS NET, ;Return from SQUERY
IOPOP NET,'NET'
FATAL IOPOP failed
POPJ 17,
;⊗ READRR READR1 READR2 READR3 READR4 RD.UNK RDDISP RD.MAX RD.DAT RD.DA1 RDOUTP RD.MX RD.DOM RD.DO1 RD.DO2 READC0 READCP READC1 READC2
;Read a resource record and enter it in the system's cache.
;Macro to copy NUM bytes from input buffer to a word, right-aligned.
DEFINE COPYB(NUM,WORD)<
SETZM WORD
MOVE 1,[POINT 8,WORD,<35-8*NUM>]
REPEAT NUM,<
ILDB 0,NETIBF+1
IDPB 0,1
>;REPEAT NUM
>;DEFINE COPYB
READRR: MOVE 3,DOMOBF ;Pointer to output buffer
ADDI 3,2 ;Start of data
MOVE 2,3 ;Make a copy for byte ptr
ADD 2,[POINT 8,RRNAME] ;Start of name
MOVEM 2,DOMOBF+1 ;Store ptr in buffer hdr
READR1: ILDB 1,NETIBF+1 ;Get a length byte
TRZE 1,300 ;Compressed format?
JRST READR3 ;Yes
IDPB 1,DOMOBF+1 ;Copy length byte
JUMPE 1,READR4 ;Jump when done
READR2: ILDB 0,NETIBF+1 ;Get a byte
IDPB 0,DOMOBF+1 ;Copy it
SOJG 1,READR2
JRST READR1
READR3: PUSHJ 17,READCP ;Read compressed name
READR4: COPYB(2,<RRTYPE(3)>) ;Copy type
COPYB(2,<RRCLAS(3)>) ;Copy class
COPYB(4,<RRTTL(3)>) ;Copy time to live
MOVE 0,RRTTL(3) ;Examine TTL
CAMGE 0,TTLMIN ;Force into desired range
MOVE 0,TTLMIN
CAMLE 0,TTLMAX
MOVE 0,TTLMAX
MOVEM 0,RRTTL(3)
COPYB(2,<RRDLEN(3)>) ;Copy data length
MOVE 1,RRTYPE(3) ;Examine type
CAIGE 1,RD.MAX ;Bounds check
JRST @RDDISP(1) ;Dispatch based on type
;Unknown record type -- skip over data bytes and ignore record
;(don't enter in system cache).
RD.UNK: SOSGE RRDLEN(3) ;End of data?
POPJ 17, ;Yes, return from READRR
IBP NETIBF+1 ;Skip a byte
JRST RD.UNK
RDDISP: RD.UNK
RD.DAT ;TY.A
RD.DOM ;TY.NS
RD.DOM ;TY.MD (obsolete)
RD.DOM ;TY.MF (obsolete)
RD.DOM ;TY.CNAME
RD.UNK ;TY.SOA
RD.DOM ;TY.MB
RD.DOM ;TY.MG
RD.DOM ;TY.MR
RD.DAT ;TY.NULL
RD.UNK ;TY.WKS (change to RD.DAT when GT.WKS is written)
RD.DOM ;TY.PTR
RD.DAT ;TY.HINFO
RD.UNK ;TY.MINFO
RD.MX ;TY.MX
RD.MAX←←.-RDDISP
;Copy data bytes for record types that don't have domain names in data.
RD.DAT: SKIPN 1,RRDLEN(3) ;Get data length
JRST RDOUTP ;Just in case ...
RD.DA1: ILDB 0,NETIBF+1 ;Copy a data byte
IDPB 0,DOMOBF+1
SOJG 1,RD.DA1
RDOUTP: OUTPUT DOM, ;Send record to system cache
POPJ 17, ;Return from READRR
RD.MX: ILDB 0,NETIBF+1 ;1st byte of preference
IDPB 0,DOMOBF+1
ILDB 0,NETIBF+1 ;2nd byte
IDPB 0,DOMOBF+1
;(fall into RD.DOM to copy host name)
;Copy a domain name into the output buffer, handling compressed format.
RD.DOM: ILDB 1,NETIBF+1 ;Get a length byte
TRZE 1,300 ;Compressed format?
JRST RD.DO2 ;Yes
IDPB 1,DOMOBF+1 ;Copy length byte
JUMPE 1,RDOUTP ;Jump when done
RD.DO1: ILDB 0,NETIBF+1 ;Get a byte
IDPB 0,DOMOBF+1 ;Copy it
SOJG 1,RD.DO1
JRST RD.DOM
RD.DO2: PUSHJ 17,READCP ;Read compressed name
JRST RDOUTP
;Follow a compressed name pointer to read and copy the rest of a name.
READC0: ILDB 0,TEMPBP ;Here when multiple pointers
JRST .+2
READCP: ILDB 0,NETIBF+1 ;Get the rest of the pointer
LSH 1,=8
ADDI 0,(1) ;Compute the byte offset
IDIVI 0,4 ;0←word offset, 1←byte
ADD 0,[ POINT 8,2 ;Make a byte ptr
POINT 8,2,7 ;(2 is for data offset from NETIBF)
POINT 8,2,15
POINT 8,2,23](1)
ADD 0,NETIBF ;Relocate to input message
MOVEM 0,TEMPBP
READC1: ILDB 1,TEMPBP ;Get a length byte
TRZE 1,300 ;Another pointer?
JRST READC0 ;Yes, what complexity!
IDPB 1,DOMOBF+1 ;Copy length byte
JUMPE 1,CPOPJ ;Return when done
READC2: ILDB 0,TEMPBP ;Get a byte
IDPB 0,DOMOBF+1 ;Copy it
SOJG 1,READC2
JRST READC1
;⊗ NAMADR NAMADA NAMAD1 NAMAD2 NAMAD3 NAMHST NAMHST NAMHS1 NAMHS2 NAMHL1 NAMHL2 SRTDAT SRTDA1 SRTDA2 COMPRI COMPR1 NANAME
;NAMADR -- Name to address translation. Looks up a name using domain
;servers or host table, and returns a list of HOSTS3 addresses sorted
;in order of preference.
; MOVEI 0,<pointer to host name string>
; PUSHJ 17,NAMADR
; <hard error, 1 points to string describing error>
; <soft error, 1 points to string describing error>
; <success, 1 points to sorted list of addresses>
;All returns provide ptr to (possibly updated) host name string in 0.
;
;A hard error indicates that the given domain name cannot be resolved
;to an address. A soft error indicates a temporary failure.
;
;Clobbers 0-11 (potentially).
↑NAMADR:SKIPE DVERBOSE
OUTSTR [ASCIZ/Domain lookup ... /]
PUSH 17,UPCASE ;Preserve around call to NAMADA
PUSHJ 17,NAMADA
SOS -1(17) ;Hard error
SOS -1(17) ;Soft error
POP 17,UPCASE
RELEAS DOM,
JRST CPOPJ2
;NAMADA does a type A query, and if it fails, looks in the host table.
;Returns 0, 1 or 2 skips. Called from NAMADR, MXADDR and MXFIND.
NAMADA: MOVEI 1,DATBLK ;Init ptr to address block
MOVEM 1,DATPTR
MOVEI 1,=10 ;Arbitrary limit for CNAME looping
MOVEM 1,CNAMEC
NAMAD1: MOVEM 0,NANAME ;Save ptr to name
MOVEI 1,TY.A ;Set up query parameters
MOVEI 2,CL.IN
PUSHJ 17,GETDOM ;Do an address query
JRST [ PUSHJ 17,NAMHST ;Name error, but check table anyway
POPJ 17, ;Not there either
JRST NAMAD3] ;Found it there
JRST [ PUSHJ 17,NAMHST ;Soft error, check table
JRST CPOPJ1 ;Not there, return soft error
JRST NAMAD3] ;Found it in table
JRST [ SOSGE CNAMEC ;Nickname, see if looping
POPJ 17, ;Yes, return error
MOVE 0,3 ;Point to real name
SETZM UPCASE
JRST NAMAD1] ;Look it up
NAMAD2: MOVEM 3,@DATPTR ;Save address
AOS DATPTR
PUSHJ 17,GETDMA ;Get next address
CAIA ;No more
JRST NAMAD2
NAMAD3: SETZM @DATPTR ;Put zero at end of list
PUSH 17,0
PUSHJ 17,SRTDAT ;Sort address list
POP 17,0
MOVEI 1,DATBLK ;Point to list of addresses
JRST CPOPJ2
;NAMHST looks up name in host table. Returns non-skip if not found,
;skip if found with (unsorted) address list in DATBLK.
IFE HSTTAB,<
NAMHST: MOVEI 1,[ASCIZ/Domain lookup failed/]
MOVE 0,NANAME
POPJ 17,
>;IFE HSTTAB
IFN HSTTAB,<
NAMHST: MOVE 0,NANAME ;Get back ptr to name
SKIPE DVERBOSE
OUTSTR [ASCIZ/Host table ... /]
PUSHJ 17,ATTHST ;Attach host table
PUSHJ 17,HSTNAM ;Try to look up the name
JRST NAMHL1 ;No such host
JRST NAMHL2 ;Ambiguous name
NAMHS1: MOVEM 0,@DATPTR ;Save address
AOS DATPTR
PUSHJ 17,HSTNXA ;Get next address
CAIA
JRST NAMHS1
SETZM NAMBLK
TRNN 1,-1 ;This host got a name?
JRST NAMHS2 ;No
HRLZ 0,1
HRRI 0,NAMBLK
BLT 0,NAMBLK+BLKLEN-1 ;Copy name to NAMBLK
MOVEI 0,NAMBLK ;Point to name
NAMHS2: PUSHJ 17,DETHST
JRST CPOPJ1
NAMHL1: SKIPA 1,[[ASCIZ/Unknown host name/]]
NAMHL2: MOVEI 1,[ASCIZ/Ambiguous host name/]
MOVE 0,NANAME ;Ptr to original name
JRST DETHST ;Detach host table and return
>;IFN HSTTAB
;Sort the list of addresses in DATBLK (terminated by 0). We use
;insertion sort, though it is O(n↑2), since the expected number of
;addresses is very small.
SRTDAT: MOVEI 0,DATBLK ;Init ptr to last inserted addr
MOVEM 0,DATPTR
SRTDA1: AOS 3,DATPTR ;Point to next addr to insert
MOVE 0,(3) ;Get address
JUMPE 0,CPOPJ ;Return if done
PUSHJ 17,COMPRI ;Compute its priority
MOVE 4,1 ;Save for comparisons
SRTDA2: MOVE 0,-1(3) ;Get previous address
PUSHJ 17,COMPRI ;Compute its priority
CAML 1,4 ;Skip if out of order
JRST SRTDA1 ;In order, done this insertion
MOVE 0,-1(3) ;Swap addresses
EXCH 0,(3)
MOVEM 0,-1(3)
CAILE 3,DATBLK+1 ;Skip if at left end of array
SOJA 3,SRTDA2 ;Still more to compare
JRST SRTDA1 ;Do next insertion
;Compute priority for address in AC 0, return value in 1. Uses 2.
COMPRI: MOVSI 2,-NUMPRI
COMPR1: XOR 0,PRIADR(2) ;Compare with an address
TDNN 0,PRIMSK(2) ;See if any masked bits are different
JRST [ MOVE 1,PRINUM(2);No difference, assign priority
POPJ 17,]
XOR 0,PRIADR(2) ;Restore address
AOBJN 2,COMPR1
SETZ 1,
POPJ 17,
NANAME: BLOCK 1
;⊗ ADRNAM ADRPTR ADRPT1 ADRPTD ADRPD1 ADRHST ADRHST ADRHS1 ADRHL1 ADADDR
;ADRNAM -- Address to name translation. Looks up an address using domain
;servers or host table, and returns a host name.
; MOVE 0,[<HOSTS3 address>]
; PUSHJ 17,ADRNAM
; <hard error, 1 points to string describing error>
; <soft error, 1 points to string describing error>
; <success, 0 points to host name>
;Clobbers 0-4 (potentially).
↑ADRNAM:MOVEM 0,ADADDR ;Save address
TLNE 0,(NN%IP) ;Is it an IP address?
JRST ADRHS1 ;No, don't bother with domain lookup
PUSHJ 17,ADRPTR ;Construct domain for PTR query
SKIPE DVERBOSE
OUTSTR [ASCIZ/Domain lookup ... /]
MOVEI 1,TY.PTR ;Set up query
MOVEI 2,CL.IN
PUSHJ 17,GETDOM ;Do an inverse address query
JRST ADRHST
JRST ADRHST
FATAL Unexpected GETDOM return in ADRNAM
MOVE 0,3 ;Return host name in 0
RELEAS DOM,
JRST CPOPJ2
;Convert an Internet address a.b.c.d to a domain name of the form
;d.c.b.a.IN-ADDR.ARPA, for use in a PTR query.
ADRPTR: MOVE 0,[POINT 7,NAMBLK] ;Init destination ptr
LDB 1,[POINT 8,ADADDR,35] ;4th byte
PUSHJ 17,ADRPTD
LDB 1,[POINT 8,ADADDR,27] ;3rd byte
PUSHJ 17,ADRPTD
LDB 1,[POINT 8,ADADDR,19] ;2nd byte
PUSHJ 17,ADRPTD
LDB 1,[POINT 8,ADADDR,11] ;1st byte
PUSHJ 17,ADRPTD
MOVE 1,[POINT 7,[ASCIZ/IN-ADDR.ARPA/]]
ADRPT1: ILDB 2,1
IDPB 2,0
JUMPN 2,ADRPT1
MOVEI 0,NAMBLK ;Point to finished string
POPJ 17,
ADRPTD: PUSHJ 17,ADRPD1
MOVEI 2,"."
IDPB 2,0
POPJ 17,
ADRPD1: IDIVI 1,=10 ;Standard decimal output routine
PUSH 17,2
JUMPE 1,.+2
PUSHJ 17,ADRPD1
POP 17,2
ADDI 2,"0"
IDPB 2,0
POPJ 17,
IFE HSTTAB,<
PRINTX ADRHST doesn't currently return dotted host number in text.
ADRHST: RELEAS DOM,
ADRHS1: MOVEI 1,[ASCIZ/Domain lookup failed/]
POPJ 17,
>;IFE HSTTAB
IFN HSTTAB,<
ADRHST: RELEAS DOM,
MOVE 0,ADADDR ;Get back address
SKIPE DVERBOSE
OUTSTR [ASCIZ/Host table ... /]
ADRHS1: PUSHJ 17,ATTHST ;Attach host table
PUSHJ 17,HSTNUM ;Try to look up the name
JRST ADRHL1 ;No such host
HRLZ 0,1 ;Ptr to name in host table
HRRI 0,NAMBLK
BLT 0,NAMBLK+BLKLEN-1 ;Copy name to NAMBLK
PUSHJ 17,DETHST
MOVEI 0,NAMBLK ;Point to name
JRST CPOPJ2
ADRHL1: MOVE 0,1 ;return ptr to dotted host number in text
MOVEI 1,[ASCIZ/Unknown host address/]
JRST DETHST ;Detach host table and return
>;IFN HSTTAB
ADADDR: BLOCK 1
;⊗ MXADDR MXFIND MXFINA MXNXTH MXFNDH MXFNH1 SRTMXA SRTMX1 SRTMX2 MXLOSE MXADDF MXNAME
IFN MXRTS,<
;Note: if our own host name is among the list of MX hosts, we should
;return only those with lower preference values. This is to prevent
;mail looping (see RFC 974). This isn't implemented yet.
;MXADDR -- Finds MX records for a domain and returns a list of HOSTS3
;addresses to use for mail exchange, sorted in order of preference. If
;that fails, tries to look up host address for the given domain.
; MOVEI 0,<pointer to domain name string>
; PUSHJ 17,MXADDR
; <hard error, 1 points to string describing error>
; <soft error, 1 points to string describing error>
; <success, 0 points to updated domain name,
; 1 points to sorted list of addresses>
;If the original name pointed to by 0 is a nickname (or not a domain
;name), the updated name will be the official domain name to use in its
;place in a mail header.
;
;Clobbers 0-11 (potentially).
;MXFIND -- Finds MX records for a domain but does not look up addresses.
;This is to save time when we just need to validate a name for mail. We
;look for an address record only if the MX query fails.
; MOVEI 0,<pointer to domain name string>
; PUSHJ 17,MXFIND
; <hard error, 1 points to string describing error>
; <soft error, 1 points to string describing error>
; <success, 0 points to updated domain name>
;
;Clobbers 0-11 (potentially).
↑MXADDR:SETOM MXADDF
CAIA
↑MXFIND:SETZM MXADDF
SKIPE DVERBOSE
OUTSTR [ASCIZ/Domain lookup ... /]
PUSH 17,UPCASE ;Preserve around call to MXFINA
PUSHJ 17,MXFINA
SOS -1(17) ;Hard error
SOS -1(17) ;Soft error
POP 17,UPCASE
RELEAS DOM,
JRST CPOPJ2
MXFINA: MOVEI 1,=10 ;Arbitrary limit for CNAME looping
MOVEM 1,CNAMEC
MXFIN1: MOVEM 0,MXNAME ;Save ptr to name
MOVEI 1,TY.MX ;Set up query parameters
MOVEI 2,CL.IN
PUSHJ 17,GETDOM ;Do an MX query
JRST MXLOSE ;No MX records
JRST MXLOSE ;Query failed
JRST [ SOSGE CNAMEC ;Nickname, see if looping
POPJ 17, ;Yes, return error
MOVE 0,3 ;Point to real name
SETZM UPCASE
JRST MXFIN1] ;Look it up
;MX query succeeded, 3 points to host, MXPREF has priority.
SKIPN MXADDF ;Is this MXFIND?
JRST CPOPJ2 ;Yes, 0 has official name
HRLZ 1,0 ;Copy official name of MX domain
HRRI 1,MXDBLK ;to MXDBLK
BLT 1,MXDBLK+BLKLEN-1
MOVE 1,[POINT 36,MXABLK];Init ptr into MXABLK (addresses)
MOVEM 1,MXAPTR
MOVE 1,[POINT 36,MXPBLK];and MXPBLK (preference values)
MOVEM 1,MXPPTR
SETZM UPCASE ;Turn off upper-case conversion
PUSH 17,DVERBOSE ;Stay silent for a while
SETZM DVERBOSE
MXNXTH: HRLZ 1,3 ;Copy name of MX host
HRRI 1,MXHBLK
BLT 1,MXHBLK+BLKLEN-1
IOPUSH DOM,'DOM' ;Save channel reading MX records
FATAL IOPUSH failed
;Note that we reuse the I/O buffers for DOM during the call
;to MXFNDH. This works, since input and output each have
;only 1 buffer.
PUSHJ 17,MXFNDH ;Find addresses for this host
IOPOP DOM,'DOM'
FATAL IOPOP failed
PUSHJ 17,GETDMA ;Get next MX host
CAIA ;No more
JRST MXNXTH
POP 17,DVERBOSE ;Restore old value
MOVEI 2,0
IDPB 2,MXAPTR ;Terminate both lists
IDPB 2,MXPPTR
PUSHJ 17,SRTMXA ;Sort all the addresses
MOVEI 0,MXDBLK ;Point to return parameters
MOVEI 1,MXABLK
JRST CPOPJ2 ;Return success
MXFNDH: MOVEI 0,MXHBLK ;Point to host name
PUSHJ 17,NAMADA ;Look up its addresses
POPJ 17, ;Doesn't have any!
POPJ 17, ;Soft error, maybe another will have an address
;Address priority is determined by position in the list
;followed by MX preference. This way we try alternate hosts
;before alternate addresses for a host that we've already tried.
MXFNH1: SKIPN 2,(1) ;Get an address
POPJ 17, ;Done all addresses for this host
IDPB 2,MXAPTR
;The absolute address in (1) can be used as the list position
;since we "know" that the list returned by NAMADA is in a fixed
;location (DATBLK). Both orderings are "lowest first".
MOVE 3,MXPREF
HRLI 3,(1) ;Compute sorting priority
IDPB 3,MXPPTR
AOJA 1,MXFNH1
;Subroutine to sort priorities in MXPBLK (and addresses in MXABLK along
;with them!), lowest first. This is an O(n↑2) sort, because in most cases
;we expect not many addresses.
SRTMXA: MOVEI 0,MXPBLK ;Init ptr to last inserted value
MOVEM 0,MXPPTR
SRTMX1: AOS 3,MXPPTR ;Point to next value to insert
SKIPN 4,(3) ;Get the priority
POPJ 17, ;Return if done
SRTMX2: CAML 4,-1(3) ;Skip if priorities out of order
JRST SRTMX1 ;In order, done this insertion
MOVE 0,-1(3) ;Swap priorities
EXCH 0,(3)
MOVEM 0,-1(3)
MOVE 0,MXABLK-MXPBLK-1(3) ;Swap associated addresses
EXCH 0,MXABLK-MXPBLK(3)
MOVEM 0,MXABLK-MXPBLK-1(3)
CAILE 3,MXPBLK+1 ;Skip if at left end of array
SOJA 3,SRTMX2 ;Still more to compare
JRST SRTMX1 ;Do next insertion
;Here if MX query fails. Look up ordinary host addresses.
MXLOSE: MOVE 0,MXNAME
JRST NAMADA ;Returns with 0, 1 or 2 skips
MXADDF: BLOCK 1
MXNAME: BLOCK 1
>;IFN MXRTS
>;IFN DOMRTS ;Last of several pages
;⊗ LDOMAN DOMAN DOMANX DOMANL A0 A1 A2 A3 OURDOM OURDO0 OURDO1 OURDOE OURDO2
IFN DOMRTS!OURRTS,<
LDOMAN←←10 ;number of words allocated to domain name string
↑DOMAN: BLOCK LDOMAN ;space for storing our system's domain name
DOMANX: ASCIZ/SAIL.Stanford.EDU/;spare host name for emergency use only
BLOCK LDOMAN+DOMANX-. ;patch space for longer emergency host name
↑DOMANL:0 ;number of chars in our domain name (for MAIL)
;OURDOM -- Get our own domain name
;Call: PUSHJ 17,OURDOM
; <always returns here>
;
;Copies system's domain name into block at DOMAN (uses lowcore 356).
;Puts length of name into DOMANL.
;If no domain name available from system, pauses (EXIT 1,) but lets you
;use a default compiled-in (patchable) domain name by CONTINUING.
;Default domain names resides at DOMANX.
;Domain names limited to LDOMAN words of ASCII.
;
;Clobbers 0-3 (potentially).
;AC names used here.
A0←←0
A1←←1
A2←←2
A3←←3
;Copy system's domain name into block at DOMAN.
;Put length of name into DOMANL.
↑OURDOM:SETZM DOMANL ;count name length in this cell
MOVEI A0,356 ;get system's pointer to its domain name
PEEK A0, ;get ptr
JUMPE A0,OURDOE ;jump if none
HRLI A0,-LDOMAN ;max length in words (makes AOBJN ptr)
MOVEI A3,DOMAN ;place to store name
OURDO0: HRRZ A2,A0 ;copy current ptr into system (can't use MOVEI)
PEEK A2, ;get one word of domain name from system
MOVSI A1,-5 ;possible number of chars in this word
MOVEM A2,(A3) ;save it
OURDO1: TLNN A2,774000 ;check high byte for zero
POPJ 17, ;end of ASCIZ name, all done
AOS DOMANL ;count a nonzero byte
LSH A2,7 ;shift in the next byte
AOBJN A1,OURDO1 ;loop unless reached end of word
ADDI A3,1 ;next word to save in
AOBJN A0,OURDO0 ;go back for next word from system
SETZM DOMANL ;overflow -- reset length and use default name
;fall into OURDOE if system domain name too long
OURDOE: OUTSTR [ASCIZ/? System pointer to its own domain name is missing or too long.
Type CONTINUE to use the host name currently patched in at DOMANX,
which is currently: /]
OUTSTR DOMANX ;you can patch name THERE, and you
EXIT 1, ; can patch HERE not to pause if you want
;now copy default domain name to current domain name
MOVE A1,[POINT 7,DOMANX] ;source of default name
SKIPA A3,[POINT 7,DOMAN] ;destination for name
OURDO2: AOS DOMANL ;count a nonzero char
ILDB A0,A1 ;copy a char
IDPB A0,A3 ;including ending null
JUMPN A0,OURDO2 ;loop unless reached end of name
POPJ 17,
>;IFN DOMRTS!OURRTS
;⊗ CPOPJ3 CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG LUZBI1 CTYMES ..NLIT
; All good things must come to an end
; Return routines
CPOPJ3: AOS (17) ;Triple skip return
CPOPJ2: AOS (17) ;Double skip return
CPOPJ1: AOS (17) ;Skip return
CPOPJ: POPJ 17, ;Return to caller
; Warning
↑WARNIN:OUTSTR @(17) ;Type the error message
ADJSP 17,-1 ;Flush ptr to error msg
OUTSTR [ASCIZ/
Please report this via GRIPE NETWORK.
/]
POPJ 17,
; Fatality!
↑LUZBIG:OUTSTR @(17) ;Type the error message
POP 17,CTYMES+1 ;Ptr to error message
PUSH 17,0 ;Get an AC
MOVEI 0,0
JBTSTS 0,
TLNE 0,10000 ;Skip if phantom (JLOG clear)
JRST LUZBI1
MOVEI 0,CTYMES
TTYMES 0, ;Type message on CTY
JFCL
LUZBI1: POP 17,0
OUTSTR [ASCIZ/
Find a wizard.
/]
EXIT 1, ;Stop the program, go away if phantom.
JRST WARNIN
CTYMES: SIXBIT/CTY/
BLOCK 1 ;Address of message
..NLIT: LIT
BEND NETWRK